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FOREWORD 


The HP PASCAL source code contained in pages G through 104 was developed for 
the Mission Planning and Analysis Division (MPAD) of NASA/JSC, and takes the 
place of detailed flow charts defining the specifications for a Utility Soft- 
ware Unit designed to support orbital flight simulators such as MANHANDLE and 
GREAS (General Research and Engineering Analysis Simulator). Besides provid- 
ing basic input /output , mathematical, vector, matrix, quaternion, and statis- 
tical routines for such simulators, one of the primary functions of the Util- 
ity Software Unit is to isolate all system-dependent code in one well-defined 
compartment, thereby facilitating transpor t a t i on of the simulations from one 
computer to another. 

Pages 1 and 2, respec t i ve 1 y , contain directives to the PASCAL compilers of 
the HP-9000 Series 200 Pascal 3.0 operating system and the HP-9000 Series 500 

HP-UX 5.0 operating system that produce in each system a single file 

of relocatable code from four separate files of source code. Three of the 
source code files ( ’Ut i Imat h , I ’ , ’ Ut i 1 vemq . I * , and ’ Ut i 1 s t at - 1 ’ ) are common 
to both operating systems. The fourth source code file ( ’ UTILSPIF . I ’ for the 
Pascal 3,0 system and ’utilspif.I’ for the HP-UX 5,0 system) contains all of 
the system-dependent PASCAL code for the Utility Software Unit. A fifth file 
of source code written in the C language ( ’ ut i 1 sc i f . c ’ , listed on pages 3 
through 5) is required to interface ’utilspif.I’ with the HP-UX “curses** 
har dware-independent terminal input/output package, which uses *'# define" 
statements extensively to define C pseudofunctions that cannot be called 
directly from a PASCAL routine. 

Pages 105 through 107 contain the Pascal 3.0 compiler directives and the 
driver source code for a unit test program. Its counterpart for the HP-UX 
5.0 operating system is contained in pages 108 through 110. The major 
portion of the unit test program source code (pages 111 through 13B) is 
common to both operating systems. Unit test results from the Pascal 3.0 
operating system are shown on pages 137 through 152. The results from the 
HP-UX operating system are shown on pages 153 through 168. 

Because its portability is limited to Hewlet t-Packard computers, HP PASCAL is 
not regarded as the best language for ultimate implementation of general 
purpose software. However, pending the availability of an ADA compiler for 
MPAD’s mainline computers, its unique features and versatility make it the 
best medium at hand for the development, testing, and maintenance of software 
specifications (which, as distinguished from executable code, is the primary 
subject of this document). The fact that interim or prototype executable 
programs can be implemented (on Hewlet t-Packard computers) simply by compil- 
ing the source code that serves as the software spec i f icat ion is considered 
to be advantageous, but it was not the reason for choosing HP PASCAL as the 
medium for specification. 
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{ begin File ’UTILUNIT.TEXT’ > 

< Utility Software Unit for HP-9000 Model 216 with Pascal 3.0 Op Sys > 

■C NASA/JSC/MPAD/TRW San Wilson } 

{ Updated Fri Apr 11 01:43:49 1986 } 

■{ This construct binds several related PASCAL nodules into a single conpila— } 
■{ tion unit so that the relocatable code produced by the conpiler will reside }■ 

< in one file rather than in many, thus sinplifying input instructions to the > 

< operating systen’s 1 inker/ 1 oader when conbining it with other relocatable } 

{ code to produce an executable progran. To sinplify editing, the source > 

<. code for each functional nodule resides in a separate file, each being } 

i naned in an "include" directive to the conpiler (see below). } 

I Except for the INUERT_MATRIX and DIAGONALIZE_SYMMATRIX procedures in nodule } 

< UTILMATH, the input paraneters for every exported function and procedure > 

•( defined in the Utility Software Unit are passed "by value" rather than } 

< “by reference". This neans that the input values are assigned to local > 

variables within the called routine, and that no reference to an input var- } 

{ iable by the called routine can nodify anything other than the local copy. > 
i It also nakes it possible in the calling routine to substitute any expres- )■ 

< Sion of the proper type (even a naned or a literal constant) for any formal > 

i input parameter in the argument list of the called routine, thus often ■ } 

< simplifying the code quite a bit. For instance, the single statement > 

<■ } 

{ 0UTPUT_AN6 := ANGDEG( ATAN2( 1.5L0, D0TP( POS, ZUNUEC ) ) ) ; } 

^ > 

< would have to be replaced by a sequence something like } 

^ > 

{ U := ZUNUEC ; > 

i X := D0TP( POS, U ) : > 

{ Y ■•= 1.5L0 : } 

i A := ATAN2( Y, X ) : } 

{ OUTPUT_ANG := ANGDEG( A ) ; > 

> 

■C if the inputs to ANGDEG, ATAN2, and DOTP were passed by reference, because > 

•{ only a variable name is allowed to replace a formal parameter that is > 

•{ passed by reference. y 

$ Sysprog On $ 

$ Swi tch_strpos $ 

i $ list off $ } $ include ’ Ut i Imath . I . ’ $ { $ list on $ X 

< $ list off $ } $ include ’ UTILSPIF . I . ’ $ { $ list on $ > 

■{ $ list off $ } $ include ’ Ut i 1 venq . I . ’ $ { $ list on $ > 

< $ list off $ > $ include ’ Ut i 1 s tat . I . ’ $ { $ list on $ > 

module UTILDUMMY : < no function: just terminates compilation tidily > 

export type SOMETHING_TO_SATISFY_CONPILER - boolean ; 

implement 

end . { File ’UTILUNIT.TEXT’ } 


« <171 
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< begin File ’utilunit.p’ > 

{ Utility Software Unit for HP-9000 Series B00 with HP-UX 5.0 Op Sys > 

{ NASA/JSC/MPAD/TRW Sam Wilson > 

{ Updated Thu Apr 10 23:01:06 1986 > 

{ This construct binds several related PASCAL modules into a single compile- > 
■( tion unit so that the relocatable code produced by the compiler will reside } 
{ in one file rather than in many, thus simplifying input instructions to the > 
{ operating system’s linker/loader when combining it with other relocatable } 
{ code to produce an executable program. To simplify editing, the source > 

< code for each functional module resides in a separate file, each being } 

{ named in an "include" directive to the compiler (see below). > 

t Except for the INUERT___MATRIX and DIAGONALI ZE__SYHMATR IX procedures in module } 
{ UTILHATH, the input parameters for every exported function and procedure > 
{ defined in the Utility Software Unit are passed "by value" rather than > 

< "by reference". This means that the input values are assigned to local > 

< variables within the called routine, and that no reference to an input var- > 
■C iable by the called routine can modify anything other than the local copy. > 

It also makes it possible in the calling routine to substitute any expres- > 
{ Sion of the proper type (even a named or a literal constant) for any formal > 

< input parameter in the argument list of the called routine, thus often > 

{ simplifying the code quite a bit. For instance, the single statement > 

< > 

{ OUTPUT_ANG := ANGDEG( ATAN2( 1.5L0, DOTPC POS, ZUNUEC ) ) ) i > 

< > 

i would have to be replaced by a sequence something like > 

< > 

{ U := ZUNUEC ; > 

< X := DOTP( POS, U ) ; > 

< Y := 1.5L0 ; > 

< A := ATAN2( Y, X ) ; > 

{ OUTPUT^ANG := ANGDEG( A ) ; > 

< > 

■( if the inputs to ANGDEG, ATAN2, and DOTP were passed by reference, because } 

i only a variable name is allowed to replace a formal parameter that is > 

< passed by reference. > 

$ s tandard_level ’hp_modcal’ $ 

$ t ype_coercion ’noncompatible’ $ 

< $ list off $ > $ include ’Utilmath.I’ $ < $ list on $ > 

$ t ype_coercion ’conversion’ $ 

< $ list off $ } $ include ’utilspif.I’ $ { $ list on $ > 

{ $ list off $ } $ include ’ Ut i 1 veroq . I ’ $ •( $ list on $ > 

{ $ list off $ > $ include ’Utilstat.I’ $ { $ list on $ > 

module UTILDUMMY ; { no function; just terminates compilation tidily > 

export type SOMETHING^TO^SATISFY^COMPILER = boolean ; 

implement 

end . { File ’utilunit.p’ > 


¥9924FDA4 
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/* begin File ’utilscif.c’ */ 


/* Utility Software Unit for HP“9000 Series 500 with HP-UX 5.0 Op Sys */ 

void nain( ) {> /* Subject : 5ystem/C Interface */ 

/* Domain : Universal */ 


/* NASA/JSC/TRW Sam Wilson */ 

/* Updated Thu Apr 10 23:13:32 1986 */ 


/* This compilation unit contains the C functions */ 
/♦ required to interface the PASCAL code with the */ 
/* appropriate HP-UX utility routines. */ 

# include <curses.h> 






void clearline( ) 

< 

int row ; 
int col ; 

getyx( stdscr, row, col ) 
move( row , 0 ) ; 
clrtoeol ( ) i 
refresh( ) j 
> 




void clearscreen( ) 

< 

clear( ) ; 
refresh( ) ; 

> 



void fetchpac( s ) char *s ; 

< 

getstr< s ) ; 

> 



void ioinitial ize( ) 

{ 

i ni t scr ( ) ; 
refresh( ) ; 

> 



void i ouni ni t i al i ze ( ) 

{ 

e n d w i Pi ( ) i 
ex i t ( 0 ) ; 

> 




vcT^rcrconr 
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void moveuplrow( ) 

< 

int row ; 
int col ; 

getyx( stdscr, row, col ) ; 
poove( row~l, col ) ; 
re f resh( ) ; 

> 



void setbrightbl ink i ( ) 

< 

attrseU AJLINK ) ; 

> 


/* 

void setcbreakC ) 

< 

cbreak( ) ; 

> 

/* 

void setcecho( ) 

< 

echo( ) ; 

> 


/* 

void setcwait ( ) 

{ 

nodelay( stdscr, FALSE ) ; 

> 


/* 

void set hal f bright i ( ) 

{ 

attrset( AJIM ) ; 

> 


void setnocbreak( ) 
{ 

nocbreak( ) ; 

> 


/* 

void setnocecho( ) 

r 

\ 

noecho( ) ; 

} 




*/ 




^ 1 ARprnpfl 
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void setnocwai t ( ) 

{ 

nodelay( stdscr, TRUE ) ; 

> 

/ * ^ ^ 

void aetnornal video( ) 

attrset( A_N0RMAL ) ; 

> 



void shoupac( s ) char *s ; 

T 

addstr( s ) ; 
refresh( ) ; 

> 

/* 

void soundalert ( ) 

< 

beep( ) ; 

> 



int kbdcharcode( ) 

{ 

return getch( ) ; 

> 

/* 

/* end File ’utilscif.c’ */ 
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$ page $ { begin File ’Utilmath.I’ > 

< Utility Software Unit for HP~‘9000 Series 200/300/500 Computers > 

module UTILMATH ; { Subject ^ Mathematics > 

{ Domain • Universal > 


{ NASA/ JSC/MPAD/TRW Sam Wilson } 

< Updated Sat Apr 12 15:23:58 1986 > 

export 

const 


UNITOL = 

4.0L-14 i 

{ ar ithmet 





{ longreal 

ZERO 


0.0L0 



ONE 


1 .0L0 



TWO 


2.0L0 



THREE 


3.0L0 



FOUR 

= 

4.0L0 



FIUE 


5.0L0 



SIX 

= 

6.0L0 



SEUEN 


7.0L0 



EIGHT 


8.0L0 



NINE 


9.0L0 



TEN 

= 

10.0L0 




ical error tolerance for computed > 
values on the order of unity > 


DEGPERRAD 

HAFPI 

PI 

RADPERDEG 

TWOPI 


5.7295779513082325L+1 
1 .57079B32G79489B6L+0 
3.1415926535897932L+0 
1 .74532925199432951-2 
G.28318530717958B4L+0 


{ degrees per radian > 
< pi / 2 > 
< pi > 

{ radians per degree > 
{ 2 * pi } 


MAXMATORDER *= 12 ; { max order of matrx to be invrtd or diagnlzd > 
MAXSQUAREINDEX - MAXMATORDER * MAXMATORDER ; 

MAXTRIANGINDEX = ( MAXMATORDER * < MAXMATORDER +1 ) ) div 2 ; 
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$ page $ 
type 


MATROWCOLNUM = 1 . . MAXMATORDER ; 


DIAGMAT = 

array [ 1 . . MAXMATORDER ] of longreal 


{ an array in which 
{’ the nonzero elements 

< of a diagonal 

< matrix M of order 

MAXMATORDER are stored in the sequence 


nil, 13, me: 


3 , , ME n , n ] . 


TRIANGMAT = 
array E 


1. .MAXTRIANGINDEX 


{ an array in which > 
] of longreal; { the nonzero elemnts > 


n = 


or 


< of a triangular 


{ matrix 

MAXMATORDER are stored in 
ME1,13, 

ME1,23, ME2,23, 


M of order 
the sequence 


MEl,nl, ME2, nl, MEn,n3 


ME1,13, 
ME2,n, ME2,; 


h 


MEn,13, MEn,21, MEn,nl, 

depending on whether M is an upper or a 
lower triangular matrix. 


SQUAREMAT = < an array in which > 

array [ 1 . . MAXSQUAREINDEX 3 of longreal ; < the elements > 

{ of a square > 

{ matrix M of order } 

{ n <> MAXMATORDER are stored in the sequence > 

{ > 

{ ME1,13, ME1,23, MEl.nl, } 

{ ME2,13, ME2,23, MC2,n3, > 

< , , > 

{ MEn.ll, MEn.2], , MEn.nJ, } 

< > 

{ which is the PASCAL storage order for the > 
{ elements of a two-dimensional n x n array. > 
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function INK X : longreal ) : integer ; 

{ INT is equivalent to the HPL “int" function (also known as > 

< the "floor*' function). Its value, which is returned to the > 

{ calling routine on the stack, is the greatest integer <> X, > 

< NOTE: INK X ) is not equal to trunc( X ) when X < 0 . > 

function FRAC( X : longreal ) : longreal ; 

{ FRAC is equivalent to the HPL "frc" function, which is never > 

{ negative. Its value, X ^ INT( X ), nay be different from } 

< the casual expectation when X < 0 . } 

function RM0D( Y, X : longreal ) : longreal ; 

{ The value of RM0D( Y, X > is zero when X = 0; otherwise its > 

< value is Y - X * INT( Y/X ), RhOD( Y, X ) is in a sense the > 

{ (long)real equivalent of the integer expression “J nod I". > 

function R5IGN( X : longreal ) : integer ; 

{ This is the "sign" function of a (long)real number. Its > 

< value is -1 if X < 0 ; otherwise its value is +1 . > 

function ISIGN( I : integer ) •• integer ; 

{ This is the "sign" function of an integer number. Its > 

i value is -1 if X < 0 ; otherwise its value is +1 . > 

function IMAX( J, I integer ) integer ; 

i This is the integer "maximum" function. Its value is the > 

< greater of its two arguments. > 

function ININ( J, I : integer ) : integer ; 

{ This is the integer "minimum" function. Its value is the > 
{ lesser of its two arguments. } 

function RMAX( Y, X = longreal ) : longreal ; 

< This is the (iong)real "maximum" function. Its value is the ) 

{ greater of its two arguments. > 

function RMIN( Y, X : longreal ) : longreal ; 

< This is the (long)real "minimum" function. Its value is the > 

< lesser of its two arguments. > 



File ’Utilmath.I’ Page 4 
$ page $ 


Printed Wed Apr 16 08:48:24 1986 


function ANGDEG( X : longreal ) : longreal ; 

< This function converts an angle from radian measure to de- } 

■{ grees . Normally it is used to convert internal values to > 

< measurement units suitable for output. ANGDEG is unique in > 

{ that angles output by every other function defined in this > 
{ module are measured in radians. > 

function ANGRAD( X : longreal ) : longreal ; 

{ This function converts an angle from degree measure to rad- > 
i ians. Normally it is used to convert external values sup- > 

< plied by the user to measurement units suitable for internal > 

•C computations. ANGRAD is unique in that the input value must > 

{ of course be measured in degrees, whereas angles input to > 

•{ every other function defined in this module must be measured } 
{ in radians . > 

function AN6K X : longreal ) : longreal ; 

{ The value of ANGK X ) is the angular equivalent of X that > 
<. lies in the range of 0 <= ANGKX) < TWOPI . > 

function ANG2( X : longreal ) : longreal ; 

{ The value of ANG2( X ) is the angular equivalent of X that > 

{ lies in the range of -PI < ANG2(X) <= PI. > 

function ATAN2( Y, X : longreal ) •* longreal ; 

{ The value returned by this function subprogram always lies > 
i in the range of -PI < ATAN2(Y,X) <= PI and is equal to > 

< arctangent( Y/X ) in the quadrant where the sine and cosine > 

i of the angle have the signs of Y and X, respectively. It is } 
i equivalent to the FORTRAN function of the same name, except > 
{ that ATAN2(0,0) undefined in FORTRAN is zero. > 

function ATANK Y, X : longreal ) : longreal i 

{ ATANl is similar to ATAN2, except 0 <= ATANK Y,X) < TWOPI. > 
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function HMS( X : longreal ) : longreal ; 

■C HMS converts X (tine neasured in seconds) to hours, minutes, } 
■C and seconds, and returns the result packed into a longreal } 

< number. HMS( X ) has the sign of X and the form hnm.ssf, > 
{. where h represents however many decimal digits are required } 
•{ to express the number of whole hours, mm and ss represent > 

< the number of additional whole minutes and seconds, and f } 

< represents the remaining decimal fraction of a second. For > 

{ example, HMS( 36385.874 ) = 1006.25874 . > 

function 5EC5( X : longreal ) : longreal ; 

< SECS is the inverse of the HMS function. It converts a time > 

{ X expressed xn hours, minutes, and seconds, and packed > 

< into a longreal number of the form hmm.ssf to the equiv- > 

{ alent number of seconds, returning the result as a longreal > 

< number. For example, SECS( 1006.25874 ) = 36385.874 . > 

function JULI AN_DAYNUM( YEAR , MONTH , DAY : integer ) *• integer ; 

{ This function returns the number of the Julian day beginning > 
{ at noon on the date defined by YEAR, MONTH, and DAY numbers } 
■i in the Gregorian (i.e., civil) calendar. For example, > 

{ JULIAN_DAYNUM( 1980, 4,2)= 2444332 is the number of the } 
T Julian day beginning at noon on 2 April 1980. > 

function TRI AN6„INDEX ( i, j : MATROWCOLNUM ) : integer ; 

< The value of this function is the one-dimens ional index (in > 
{ an array of the type TRIANGMAT) of the element M[i,j] from a > 

< triangular matrix M. > 
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procedure INVERT_MATRIX ( 


anyvar MATRIX 
ORDER 

anyvar INVERSE 


SQUAREMAT : 
MATROWCOLNUM : 
SQUAREMAT ) 


< Given < in MATRIX ) the elements of a square matrix of order > 
i no greater than MAXMATORDER, this procedure will compute the > 

> 


elements of its inverse (if it exists) and return them to 
the calling routine in the output variable INVERSE. The 
"anyvar" notation in the parameter list causes the normal 
PASCAL t ype~c hec k i ng rules to be relaxed, and makes it per- 
missable in the calling routine to substitute, for MATRIX 
and INVERSE, the names of variables that are not actually 
declared to be of the type SQUAREMAT. For example, the 
calling routine might legitimately contain the following 
5 1 at ement s • 


type 


MAT4X4 = array 
MAT3X9 - array 


1.. 4, 1..4 ] of longreal 

1.. 9, 1..9 ] of longreal 


var 


L 

M 

N 


MAT4X4 

MAT4X4 

MAT9X9 


begin 


INVERT_^MATRIX ( L, 4, 
INVERTJ1ATRIX ( N, 9, 

end ; 


As indicated by the second reference to INVERT_MATRIX , it 
is permissable to substitute the same variable name for 
MATRIX and INVERSE if one wishes to overwrite the original 
matrix with its inverse. 


{ Program execution will be aborted with an escapecode of 9901 

< if the input matrix turns out to be singular, and no value 

{ will be assigned to INVERSE. The reference to INVERT_MATRIX 
{ should be embedded in a " try/recover " construct if it is 

< desired to provide exception-handling code in the calling 

< routine to recover from such an eventuality. 


1 1 


¥3D15CFB5 
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procedure DIAGONALIZE_SYMMATR IX ( anyvar SYfIMET : TRIANGMAT j 

ORDER : HATROWCOLNUM ; 

TOLRATIO : longreal ; 

anyvar DIAG : DIAGMAT ; 

anyvar ORTHOG : SQUAREMAT ) ; 

{ Given (in SYNMEF) the unique elements of a symmetric matrix } 
{ o of order no greater than MAXMATORDER, this procedure uses } 
{ the Jacobi method of iteration to find an orthogonal matrix > 

< M that will transform an unknown diagonal matrix D into S by > 

{ use of the equation S = T * D * M, where is the matrix > 

i multiplication operator and T is the transpose of M. Itera- > 
{ tion ceases when a value of M is found such that every )” 

{ off”diagonal element of an approximated diagonal matrix, > 

{ D’ = M * S * T, has an absolute value no greater the product > 

{ of the input parameter TOLRATIO with the root “mean-square > 

< magnitude of the diagonal elements of D (which can be com- > 

< puted easily even though the individual elements of D are > 

{ unknown). After the convergence test is satisfied, the di- > 
T agonal elements of the approximation D’ are returned to the } 
{ calling routine as components of the output variable DIAG > 
T and the final value of M is returned in the output variable > 
{ ORTHOG. 

< If D’ has not converged to the specified tolerance after a } 

< reasonable number of iterations (50 times the order of 5), > 

< the values of M and D’ are NOT returned to the calling > 

{ routine, and program execution is aborted with an escapecode > 

< of 9902. The reference to DI AGONALI ZE_SYMMATRIX should be } 

{ embedded in a " try/recover " construct if it is desired to > 
{ provide excsp t ion-handl ing code in the calling routine to > 
{ recover from such an eventuality. > 

T As in the case of the INUERT_MATRIX procedure, use of the > 
{ "anyvar" notation in the parameter list makes it possible in > 

< the calling routine to substitute (for SYMNET, DIAG, and > 

< ORTHOG) the names of variables that are not actually de- > 

i dared to be of the types indicated in the formal parameter > 
{ list. The DIAGONALIZE procedure code in the UTILUEMQ module > 
<. contains an example of DI AGONALI ZE_SYMMATRIX usage, > 


^nAr7P9?7 
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$ page $ 
implement 
type 

DIA6P0INTER = '"DIAGMAT ; 

SQUAREPOINTER = ''SQUAREMAT ; 

TRIANGPOINTER = ''TRIAN6MAT ; 

var 

INi; : SQUAREPOINTER ; 

MAT : SQUAREPOINTER : 

MATORDER = integer : 

SYM : TRIANGPOINTER ; 

function SQUARE_INDEX ( i, j = MATROWCOLNUM ) = integer ; 
procedure EXCHANGE_ROWS ( i , j = MATROWCOLNUM ) 


forward ; 
forward : 


¥13E17FC1 
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function INK X = longreal ) = 
var 


I : integer ; 


begi n 

I := trunc( X ) ; 
if X < ZERO then 

if X <> I then 

I I - 1 ; 

INT I ; 
end ; 


function FRAC( X = longreal ) = 
var 


F : longreal ; 

begin 

F : X - trunc( X ) ; 

if F < ZERO then 

F F + ONE ; 
FRAC := F ; 
end ; 


function RN0D( 

Y , X : 

longrea 1 

begi n 



if X = ZERO 


t hen 

RMOD 

ZERO 

else 

RNOD := 

Y - X ^ 


end ; 


int eger ; 


longreal ; 


) longreal ; 


INK Y / X ) 




1 ^ 
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function RSIGN( X : longreal ) 
begin 

if X < ZERO 

then RSIGN := -1 
else RSIGN := 1 ; 

end ; 


function ISIGN( I : integer ) : 

begin 
if I < 0 

then ISIGN := -1 
else ISIGN := 1 ; 

end ; 


function IMAX( J , I : integer 

begin 
if I > J 

then I MAX I 
else IMAX := J ; 

end ; 


function IMIN( J , I : integer 

begin 
if I < J 

then IMIN := I 
else IMIN := J ; 

end ; 


function RMAX< Y , X : longreal 

begin 
if Y > X 

then RMAX := Y 
else RMAX == X ; 

end ; 


function RMIN( Y , X : longreal 

begin 
if Y < X 

then RMIN := Y 
else RMIN := X ; 

end ; 


: integer 


i nteger 


) : integer ; 


) : integer ; 


) longreal ; 


> longreal 


^47? -)87>47i 


1 1 =: 
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function ANGDEGv X : longreal ) : longreal ; 
begin 

ANGDEG := X * DEGPERRAD ; 
end ; 


function ANGRAD( X : longreal ) : longreal ; 
begin 

ANGRAD := X * RADPERDEG ; 
end ; 


function ANGK X : longreal ) : longreal 
begin 

ANGl := TWOPI » FRAC( X / TUIOPI ) ; 
end ; 


function ANG2( X : longreal ) = longreal ; 
var 

A : longreal ; 

begin 

A := TWOPI * FRAC( X / TWOPI ) ; 
if A > PI then A A - TWOPI ; 

ANG2 := A ; 
end ; 


^ 1 nAF4RRF 
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function ATAN2( Y , X : longreai ) 
var 

A • longreai ; 

XSQ •• longreai ; 

YSQ : longreai ; 

begin 

YSQ := sqr( Y ) ; 

XSQ := sqr( X ) ; 
if( YSQ + XSQ ) = ZERO 

then A := ZERO 

else 

begin 

if YSQ > XSQ 
then 

A HAFPI - arctan( 

else 

begin 

A := arctan( abs( Y / 
if X < ZERO then A 
end ; 

if Y < ZERO then A : = -A 
end ; 

ATAN2 := A ; 
end ; 


function ATANK Y , X : longreai ) 
begin 

ATANl := ANGK ATAN2( Y, X ) ) 
end ; 


longreai ; 


X / abs< Y ) ) 


X ) ) ; 
PI - A ; 


longreai ; 




1 
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function HMS( X = longreal ) = iongreal ; 
var 

A : iongreal ; 

H : integer ; 

M : integer ; 

S : longreal ; 

begin 

A := abs( X ) ; 

H := trunc( A/3600 ) ; 

M := trunc( A/B0 ) - G0*H ; 

S := A “ 60 * < M + 60*H ) ; 

HMS := RSI6N( X ) * ( 100*H + M + S/100 ) ; 
end ; 


function SECS< X ; longreal ) = longreal ; 
var 

A : longreal ; 

H : integer ; 

M : integer ; 

S : longreal ; 

begin 

A :-■= abs( X ) ; 

H := trunc( A/100 ) ; 
n •= trunc( A ) - 100*H ; 

S 100 * ( A M - 100*H ) ; 

SECS := RSIGN( X ) * ( G0 * ( G0*H + M ) + S ) ; 
end ; 


function JULIAN_DAYNUM( YEAR , hONTH , DAY = integer 
var 

D : integer ; 

I : integer ; 

begin 

if MONTH < 3 

then I := 1 
else I : = 0 ; 

D := DAY ~ ^<i07B t ( 1461 * ( YEAR + 4800 — I ) 

D D + ( 3G7 ( MONTH - 2 + 12*1 ) ) div 12 ; 

D := D - ( 3 * ( ( YEAR + 4900 - I ) div 100 ) ) 

JULIAN^DAYNUM == D ; 
end ; 


) : integer 


) div 4 ; 
di V 4 ; 




1 « 
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function TRIANG_INDEX( i, j • HATR0WC0LNUM ) 
var 


h : MATROWCOLNUM ; 
k : MATROWCOLNUM ; 

begin 

h IMIN( i, j ) ; 

k IMAX( i, j ) ; 

TRIANG_INDEX == h + ( k * ( k~ 1 ) ) div 
end ; 


function SQUARE_INDEX( i, j ^ MATROWCOLNUM ) : 
begin 

SQUARE__INDEX — j + ( i - 1 ) * MATORDER ; 
end ; 


■ integer ; 


integer ; 


vAAc;^^? 1 nr 
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procedure INUERT_MATR IX 


anyvar MATRIX 
ORDER 

anyvar INVERSE 


: SQUAREMAT ; 

: MATROWCOLNUM ; 

: SQUAREMAT ) ; 


var 


BESTROW 

MATROWCOLNUM 

BESTOAL 

longreal 

i 

MATROWCOLNUM 

i j 

integer 

ik 

integer 

j 

MATROWCOLNUM : 

k 

MATROWCOLNUM 

kj 

integer 

kk 

integer 

MIK 

longreal 

X 

longreal ; 

Y 

longreal ; 

Z 

longreal ; 


begin 

MATORDER •'= ORDER i 

new ( MAT ) ; < allocate storage for working copy of MATRIX > 

new ( INO ) ; { allocate storage for working copy of INUERSE > 

BESTOAL ZERO ; 
for i := 1 to MATORDER do 

for j := 1 to MATORDER do 
beg i n 

ij := SQUARE_INDEX( i, j ) ; 
if j = i 

then INO^’Cij] := ONE 
else INUnij] := ZERO i 
MAT"C ij ] := MATRIX! iJ ] ; 
if j = 1 then 
beg i n 

X := abs( MAT'Cij] ) ; 
if X > BESTUAL then 
begin 

BESTUAL X ; 

BESTROW := i ; 
end ; 

end ; 

end ; 


V onnon A ca 
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for k 1 to MATORDER do 
begin { k loop > 

if BESTWAL = ZERO then escape < 9901 ) ; { MATRIX is 

if BE5TR0W <> k then 

EXCHANGE_ROU)S( k, BESTROW ) ; 
kk := SQUARE_INDEX( k, k ) ; 

X := ONE / MAT'-'Ckk] ; 
for j := 1 to MATORDER do 
begin 

kj := SQUARE_INDEX( k, j ) ; 

MAT'Ckj] := X * MAT"[kj] ; 

INU'Ckj] := X * INU'Ckj] ; 
end ; 


BESTOAL ZERO ; 

for i 1 to MATORDER do 

if i <> k then { nullify column k of row 

begin 

ik := SQUARE_INDEX( i, k ) i 
MIK := MAT'’[ik] ; 
for j 1 to MATORDER do 
begin 

ij := SQUARE^INDEX( i, j ) j 

kj := SQUARE_INDEX( k, j ) ; 

Y := MAT^'C ij] ; 

Z := MIK * MAT''[kj.l ; 

MAT"[ij] := Y - Z ; 

INO^ij] := INU^ij] - MIK * INUnkj] ; 

if ( j = k. + l ) and ( i > k ) then 

begin 

X := RMAX( abs( Y ), abs( Z ) ) ; 
if X > ZERO then 


begin 

X := abs( MAT'-'Li j ] / X ) ; 
if X > BESTUAL then 
begin 

BE5TUAL X ; 

BESTROW := i ; 
end ; 


end ; 


end ; 


end ; 

end ; 

end ; { k loop > 
for 1 := 1 to MATORDER do 


singular > 


i in MAT > 


for j := 1 to MATORDER do 
begin 

ij := SQUARE_INDEX( i, j ) ; 

INUERSECij] := INO'-'lij] ; 

< release temporary storage > 
{ release temporary storage ) 


end ; 

dispo5e( MAT ) ; 
disposeC INU ) ; 


ytr'-7frrAiDC/^ 
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procedure EXCHANGE_ROWS ( i , j 
var 

ik : integer ; 

jk : integer ; 

k : MATROUICOLNUM ; 

X : longreal ; 

Y : longreal ; 

begin 

for k 1 to MATORDER do 


begi 

n 



ik : 

= SQUARE_INDEX( 1 

jk = 

= SQUARE_INDEX( j 

X : = 

MAT" 

[ik] ; 


Y : = 

INU" 

[ik] ! 


MAT" 

[ik] 

;= MAT" 

[ jk] 

INV" 

[ik] 

:= INU" 

[ jk] 

MAT" 

[ jk] 

:= X : 


INU" 

[ jk] 

;= Y i 


end 

1 




end ; 


: MATROWCOLNUM ) ; 


k ) ; 
k ) ; 
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procedure DIAG0NALI2E_SYMMATRIX ( anyvar SYMMET : TRIANGMAT ; 

ORDER : MATROWCOLNUM ; 

TOLRATIO : longreal : 

anyvar DIAG : DIAGMAT : 

anyvar ORTHOG : SQUAREMAT ) ; 


var 


ADJUSTED 

boolean 

CA 

longreal 

CASQ 

1 ongreal 

1 

MATROUICOLNUM 

i i 

integer 

i j 

i nteger 

ik 

integer 

ITNUM 

i nteger 

j 

MATROUICOLNUM 

j j 

integer 

jk 

integer 

k 

MATROUICOLNUM 

HAXITERATIONS 

integer 

RMSEIGENUAL 

longreal 

SA 

longreal 

SASQ 

longreal 

THRESH 

longreal 

TOL 

longreal 

X 

longreal 

Y 

1 ongreal 

YSACA 

longreal 

Z 

1 ongrea 1 


begin < procedure DIAGONALIZE_SYMMATRIX } 

MATORDER := ORDER ; 

new< SYM ) ; { allocate storage for working copy o 

neu( MAT ) ; { allocate storage for working copy o 

Y := ZERO ; 

Z := ZERO ; 

for i := 1 to MATORDER do 

for j := 1 to MATORDER do 
begin 

ij := SQUARE_INDEX( i, j ) ; 
if j = i 

then MAT^Cij] := ONE 
else MAT-'llj] := ZERO : 
if j >= i then 
begin 

ij := TRIANG_INDEX( i, j ) ; 

X : = SYMMETli j ] i 
SYM''[ i j ] := X : 
if J = i 

then Y ; = Y + sqr( X ) 
else Z := Z + sqr( X ) : 

end ; 

end ; 

RMSEIGENUAL := sqrt( < Y + Z + Z ) / MATORDER ) : 

TOL := RMSEIGENUAL * TOLRATIO : 

THRESH := sqrt( Z ) / MATORDER ; 


f SYMMET > 
f ORTHOG > 
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MAXITERATIONS = = 50 * MATORDER : 

ITNUM := 0 ! 
repeat 

ADJUSTED := false i 
for j := 2 to MATORDFR do 
begin { j loop > 
jj == TRIAN6_INDEX< j, j ) ; 
for i := 1 to j - 1 do 
begin < i loop > 
ii ••= TRIAN6_INDEX( i, i ) ; 
ij := TRIAN6_INDEX( i, j ) ; 
if abs< SYM'lij] ) > THRESH then 
begin { matrix adjustment > 

X == SYM''[ii] - SYM-'Cjj] : 

Y := TWO * SYM^lij] : 

Z == Y / sqrt< sqr( X ) + sqr( Y ) ) : 

if X < ZERO then Z == -Z ; 

SA := Z / sqrt( TW0*( ONE+sqrt ( ONE-sqri Z ) )) ) ; 

SASQ := sqr( SA ) ; 

CASQ == ONE - SASQ ; 

CA ;= sqrt( CASQ ) ; < CA = cosine of rotation angle } 
YSACA := Y * SA * CA : 

Z := SYMMill ; 

SYM''[ii] := I * CASQ + YSACA + SYM''[jj] * SASQ : 

SYM''Cjj] : = Z * SASQ - YSACA + 5YM"[Jj] * CASQ : 

SYM’'[ij] =“ ZERO ; { but next rotation may change it 1 
for k := 1 to MATORDER do 
begin 

if k <> i then 

if k <> j then 
begin 

ik == TRIAN8_INDEX( i, k ) ; 

jk == TRIANG_INDEX( j, k ) ; 

Z == SYM"[ik] : 

SYM-'Cikl == SYM'Tjk] * SA + Z * CA ; 
SYM^IJE] := SYM-'Cjkl * CA - Z * SA : 
end i 

ik := SQUARE_INDEX( i, k ) ; 
jk := SQLIARE_INDEX( j, k ) ; 

Z := MAT"[ik] ; 

MAT-'-likl := MAT^jk] * SA + Z * CA ; 

MAT'-Ejkl := MAT''[jk] * CA - Z * SA ; 
end ; 

ADJUSTED := true : 
end : { matrix adjustment > 
end ; { i loop > 
end ; < j loop > 
if not ADJUSTED then 

if THRESH > TOL then 

begin < threshhold adjustment > 

THRESH := THRESH / MATORDER : 

ADJUSTED == true ; 

end ; { threshhold adjustment } 

ITNUM == ITNUM + 1 ; 

if ITNUM > MAXITERATIONS then escape ( 9902 ) ; { abort pgm exect’n > 
until not ADJUSTED ; 
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for i:= 1 to MATORDER do 
begin 

ii := TRIANG_INDEX( i, i ) ; 

DIAGl i ] := SYM”[ ii ] ; 
for j := 1 to MATORDER do 
begin 

ij := SQUARE_INDEX( i, j ) ; 

ORTHOGlij] := MAT"[ij] j 
end ; 

end ; 

dispose( SYM ) ; { release temporary storage > 

dispose( MAT ) ; { release temporary storage > 

end ; { procedure DI AGONALI ZE^SYfiMATR IX > 

end ; { module UTILMATH & File ’Utilnath.I’ > 



File MJTILSPIF.I’ Page 1 
$ page $ { begin File ’UTILSPIF.I’ > 


Printed Ued Apr 16 08:56:21 1986 


< Utility Softujare Unit for HP-9000 Model 216 with Pascal 3.0 Op Sys > 


module UTILSPIF 


{ Subject : Systsn/PASCAL Interface > 
{ Domain : Universal > 


{ NASA/JSC/MPAD/TRW Sam Uli Ison > 

< Updated Fri Apr 11 01:44:41 1986 > 


{ This one module contains all of the sys tern-dependent 
data and PASCAL code needed for most app 1 icat ions . 

i mpor t 


Sysglobals , 
Sysdevs , 
Rnd , 
General_l , 


UTILMATH ; 


{ Pascal 3.0 

< Pascal 3,0 

< Pascal 3.0 

< Pascal 3.0 


system module > 
system module > 
system module > 
system module > 


} 

> 


export 

const 


TICKSPERSEC 

= 

100 


r 



{ Ser 

ies 200 

clock 

resolut ion 

> 

DATELEN 

24 

< 

nunh 

‘jer of c 

haract 

ers i n 

dat e-and-t ime 

string 

> 

LINELEN 

80 

{ 

max 

charact 

ers 

i n 

input / 

output 

line string 

> 

NAMELEN 

8 ; 


max 

charac t 

ers 

i n 

"name” 

string 



> 

PROMPTLEN = 

60 i 

{ 

max 

charact 

ers 

i n 

promp t 

string 

for user input 

> 

WORDLEN 

20 ; 


max 

charac t 

ers 

in 

"word" 

string 



> 
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type 

RANDOniNT = l..raaxint-l ; { pseudorandom integer : 1 .. 2 1 47483646 > 

DATESTR = Strang [ DATELEN ] ; 

LINESTR = string t LINELEN 1 ; 

NAMEPAC ~ packed array 1 1..NAMELEN ] of char ; 

NAHESTR = string C NANELEN 1 ; 

PROMPTSTR = string [ PROMPTLEN 3 ; 

WORDSTR = string [ WORDLEN 3 ; 


CHWAITMODE = ( { describes wait mode for CHAR__INPUT function > 

CHWAIT, { wait if input buffer is empty } 

NOCHWAIT ) ; { don’t wait if input buffer is empty > 

CHECHOnODE = ( { describes echo mode for CHAR_INPUT function > 

CHECHO, { echo characters back to UvSer terminal screen > 

NOCHECHO ) ; < don’t echo characters hack to user terminal > 

GOTWHAT - ( { describes result of executing CHAR_INPUT functn > 

NOTHING, { the input buffer was empty (& didn’t wait) > 

ENDOFLINE, < got an end“of*“line char ( (RETURN) keystroke) > 

SOMETHING ); < got a character that was not end~of-line > 

CHINPUTREC = 

record { returned by the CHAR_INPUT function > 

Q : GOTWHAT ; { qualifier for the returned character > 

C : char ; { C = ’ ’ if Q = NOTHING or ENDOFLINE; > 

end ; { record > { else C = char produced by user keystroke > 


var 

LP : text ; { standard file for printed output; must be } 

< opened by "rewrite" statement somewhere in > 

< program before use > 


¥BBC29E82 
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P 


rocedure 


INITIALIZE^IO 


< This procedure performs the I/O system initialisation re- > 
{ quired to support most app 1 i ca t i ons . Normally it should be > 

< the first procedure called by any program, } 


procedure CLEAN_UP_IO ; 

{ This procedure closes any open files and generally cleans > 
{ up the I/O system. Normally it should be the last procedure } 
<. called by any program. } 


procedure CLEAR_LINE ; 

i This procedure clears the line on the user terminal where } 
{ the cursor is currently located. > 


procedure CLEAR_SCREEN ; 

■{ This procedure clears the user terminal screen. 


> 


procedure FETCHLN ( var STR 


LINESTR ) ; 


{ This procedure reads (and thus removes) characters from the > 
{ user terminal input buffer storing them in the string > 

< variable STR until an end^of-line character (generated > 

{ by a <RETURN>* keystroke) has been read. The end-of-line > 

< character is always discarded, along with any other charac- } 
{ ters in excess of the number (LINELEN) needed to fill the > 

< variable STR to its maximum capacity. } 


{ 

< 

< 

< 

< 


* NOTE: Some keyboards, instead of having a <RETURN> key, 
have an <ENTER> key that serves the same purpose. 
Wherever "<RETURN>‘‘ appears in this and following 
descriptions, it should be interpreted as “<RETURN> 
or <ENTER>, whichever is present on the keyboard”. 


> 

> 

> 

> 

> 


procedure LOITER ( MILLISECS : integer ) 


{ 

< 



This procedure loops through meaningless code (effectively 
suspending program execution) for the number of milliseconds 
specified in its argument . 


} 

> 

> 


¥F28BC246 
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procedure MOUE_UP ; 

{ This procedure noves the cursor up one line on the user > 

{ ierninal. > 

procedure SET^BR IGHTBL INK^I NUERSE^W IDEO ; 

{ This procedure causes characters to be written on the user } 

-C terminal screen in the blinking bright inverse video mode, > 

{ which remains in effect until another mode is specified. > 

procedure SETJALFBRIGHT^I NUERSE^UIDEO ; 

{ This procedure causes characters to be written on the user } 

< terminal screen in the halfbright inverse video mode, > 

■C which remains in effect until another mode is specified. > 

procedure SET_NORMAL_UIDEO ; 

i This procedure causes characters to be written on the user > 

{ terminal screen in the normal video mode, which remains in > 

< effect until another mode is specified. > 

procedure SHOW ( STR : LINESTR ) ; 

< This procedure writes a PASCAL string to the user terminal. > 

procedure SHOWLN ( STR : LINESTR ) ; 

{ This procedure writes a PASCAL string to the user terminal, > 
{ and then positions the cursor at the beginning of the next > 

< line. > 

procedure SOUND_ALERT ; 

< This procedure causes an audible signal to be sounded at the > 
{ user terminal, often to indicate that the program is waiting > 
{ for input from the user, sometimes (in real-time simulators) } 

< to indicate that the program is ignoring an attempted input > 

< because it is not valid or not capable of timely implementa- > 

< tion in the current c ircumstance . > 

procedure SOUND__ALARh ; 

< This procedure causes a distinctive audible signal to be } 

< sounded at the user terminal, usually to indicate that some > 

< error condition has occurred that requires corrective action > 

{ on the part of the user, > 


¥BE4BF6EB 
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procedure START_NEU_PAGE ; 

{ This procedure causes a page-eject character to be written > 

< to the standard pr int ed-ou tput file LP, which must have been > 

< opened somewhere in the program with a "rewrite" statement. } 

procedure START_RANDOM_NUMBER__SEQUENCE ( SEED : RANDOMIIMT ) ; 

< This procedure uses the argument SEED to initiate a repeat- > 

< able sequence of pseudorandom numbers. > 

function RANDOM_^INTEGER : RAIMDOMINT j 

{ This function returns a pseudorandom integer from a uniform > 
{ distribution in the range of 1 to MAXINT-i (i.e., in the. > 

< range of 1 to 2147483646). > 

function CLOCKTICK : integer ; 

< This function returns an integer corresponding to the number > 

< of "ticks" registered on the system clock since some arbi- > 

< trary fixed time in the past. > 

function CPUTICK integer ; 

< This function returns an integer number that grows at the > 

< rate of the expenditure of CPU time (measured in system > 

■( clock "ticks") to support the calling process. > 

function DATESTRING : DATESTR ; 

< This function returns a PASCAL string describing the current > 

< date and time in the form, e.g., "Tue Feb 18 17:32:25 1986". > 

function NANESTRING( PAC : NANEPAC ) : NAMESTR ; 

{ This function returns a PASCAL string formed by removing } 

< any blank spaces found in the input PAC (packed array of } 

{ characters ) . > 

function UPPER_CASE( C : char ) : char ; 

{ If C is a lower-case letter of the alphabet this function } 

< returns its upper-case counterpart ; otherwise it returns > 

{ C unchanged. > 


V D'77 
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function CAPW0RD( WORD : WORDSTR ) : WORDSTR ; 

{ This function returns a string formed by replacing all } 

< lower-case letters in the input WORD (if any) with their } 

< upper-case counterpart s . > 

function CHAR_INPUT( WflODE CHUAITMODE ; 

EMODE : CHECHOMODE ) : CHINPUTREC ; 

<- If the user terminal input buffer is empty when this func- > 
{ tion is called, it will will either wait for a character to > 

< be input or return immediately to the callivig routine, de- > 

< pending on whether the value of WMODE is CHWAIT or NOCHWAIT. > 

< Whenever it finds the buffer unempty, it removes one char- > 

{ acter and if the value of EMODE is CHECHO it echoes that > 

< character back to the user terminal. If WMODE = NOCHWAIT > 

{ and the input buffer is empty then the value of CHAR__INPUT . Q > 
{ is NOTHING; if an end-of-line character is read from the > 

< buffer (the result of the user having pressed the < RET URN > * > 
key) then the value of CHAR_INPUT.Q is ENDOFLINE; otherwise } 

< the value of CHAR^INPUT.Q is SOMETHING and the value of > 

CHAR__INPUT , C 15 the character that was read from the buffer. } 

< CHAR_INPUT.C = ’ ’ (the space character) when the value of > 

i CHAR^INPUT.Q is NOTHING or ENDOFLINE. > 

function USER JECIDES_TO( DO^THIS : PROMPTSTR ) : boolean ; 

< The D0_THIS input string should describe a tentative action, > 
{ and after appending the characters ’ ? ’ it should also form > 

< a question that can be answered "yes" or "no" by the user > 

{ (with a single keystroke, as explained below). The boolean > 
i value of this function is TRUE if the user’s answer is "yes" > 
{ and FALSE if the answer is "no". > 

< The USER_DECIDES_TO function code causes the D0_THIS string, > 

{ followed by the characters ’ ? ’ , to be displayed on the > 

< user terminal screen in normal video mode, and then it waits > 

< for the user to press a single key indicating his decision. > 

{ Pressing ’Y’, ’y’, or the <RETURN> key indicates "yes". If > 

< the user presses ’H’,’h’, or ’?’ (thinking perhaps to obtain > 

< a further description of available options), the SOUND__ALARri > 
{ procedure is invoked to give an audible error signal. Any > 
i other keystroke is interpreted as "no". As soon as an an- > 

< swer is received, an appropriate character string (’YES’ or > 

< ’NO’) is displayed in half-bright inverse video mode immed- > 

< lately behind the prompting question, and the correspond! ng > 

boolean value (TRUE or FALSE) is returned to the calling > 

< routine. > 
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f unct ion 


function 


WORD^INPUK PROMPT : PROMPTSTR ; 

DEFAULT : WORDSTR ) : WORDSTR ; 

< The PROMPT string, followed by the characters ’ : * , is dis~ > 

{ played on the user terminal screen in normal video mode and } 

<. followed on the same line by a display of the DEFAULT value > 
{ in blinking bright inverse video mode, signifying that the > 

<. user may approve the blinking value as shown or else supply > 
{ another value (which will replace the one currently blinking > 

< and become the new value to be approved or replaced). When > 

{ satisfied with the blinking value, the user terminates the > 


< input process with a single < RETURN > keystroke (i.e., one > 

{ not that is not preceded by any other keystroke). This > 

i causes the display mode of the blinking value to be down- > 
{ graded to steady half-bright inverse video, indicating its > 

< acceptance by the user. The user-approved value (a charac- } 

{ ter string) is returned (on the stack) to the calling rou- > 
T tine as the value of the functon WORD_INPUT. > 

< If the PROMPT string does not contain a pair of braces (like > 

< the ones enclosing each of these comment lines), then the > 

{ user may type in any character string of his choosing, > 

< which must be terminated with a < RETURN) keystroke. After > 
{ deleting any leading or trailing blank spaces, and any other > 

< characters in excess of the number ( WORDLEN ) required to > 


T fill the INPUT_WORD function value to its maximum capacity, > 

< the value thus supplied will replace the previous blinking > 

< value on the user terminal screen. This cycle is repeated } 
•C until a blinking value is approved in the fashion described } 

< in the preceding paragraph. > 

{ Braces like the ones enclosing this line if present in > 

{ PROMPT contain a comma-separa t ed list of the only char- > 

< acter strings that are permissable input values, from which > 
{ the user must make a choice. If the blinking value is not > 

< acceptable to the user, pressing the or the ’<’ key will > 

< cause its predecessor in the list to be displayed in the > 

< blinking mode for possible approval; pressing any other key > 
{ except <RETURN> will cause its successor in the list to be > 

< displayed instead. Running off the end of the list in > 

{ either direction causes a " wraparound " to the opposite end. > 
T The maximum number of values allowed in the list is ten. > 


RJWORD_INPUT( PROMPT PROMPTSTR ; 

DEFAULT : WORDSTR ; 

FIELD : integer ; 

•MAXLEN : integer ) : WORDSTR . 


< 

{ 

r 

K 


This function works exactly like WORD_INPUT except that the } 
the user-input "word", when displayed on the user terminal > 
screen, is r i ght- just i f ied in a space at least FIELD columns > 


A 4- 


1 U 

JL W » I ^ ^ » 


4- c 


greater than MAXLEN. 


> 


A * ~7 Hi 
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function INTEGER_INPUT( PROMPT : PROMPTSTR ; 

DEFAULT : integer ; 

FIELD : integer ) : integer ; 

< This function works very i^iuch like R JWORD._INPUT except of } 
course the function value is an integer instead of a string, > 

< which makes the MAXLEN argument of RJWORD_INPUT inappropri'- > 
■i ate in this case. If the user types in a number in fixed- > 
i point decimal format, it is truncated to make it an integer > 

< <i.e., the decimal point and any characters following it are > 

< ignored). Any attempt on the part of the user to input a > 

< non-numeric value causes an audible error signal to be pro- > 
{ duced by the SOUND_ALARM procedure, and the blinking value > 

remains unchanged, } 

function FIXED_INPUT( PROMPT : PROMPTSTR ; 

DEFAULT : longreal ; 

FIELD : integer ; 

PLACES : integer ) : longreal ; 

{ This function is similar to I NTEGER_INPUT except that the } 
{ function value is a longreal number instead of an integer. > 
{ A fixed-point format is always used to display the function > 

< value on the user terminal screen, and the PLACES argument > 

< specifies how many digits are to be shown after the decimal > 
i point. If the user types in a number with more digits than > 
{ what is called for by the PLACES argument , it is rounded to > 

< the nearest decimal digit in the last place shown on the > 

< screen. The same applies to the DEFAULT value supplied > 

< by the calling routine. Within the limits of precision that > 
{ are inherent in the t rans f orma t i on between the binary and > 

the decimal representat ion of a number, the function value > 

< returned to the calling routine is exactly that which is > 

•{ shown to the user, with no significant decimal digits lurk- > 
{ ing unseen beyond the last one displayed (i.e., "what you > 

< see is what you get"). > 

{ This function does not require user input to be typed in a > 
■i fixed-point format. Integer format is acceptable for whole > 
{ numbers, and it is not necessary to type "0" before the dec- > 
{ imal point of a fraction nor behind that of a whole number. > 

< An exponential format may be used if that is the user’s > 

T preference. For example, the value displayed on the user } 

{ terminal screen and returned to the calling routine > 

i as "150.00“ may have been typed in by the user as "149.996", > 
{ "150“, "150.“, "1.5+2", “1.5e2“, or " 1 . 499963L2 " . If the > 
\ user attempts to input a non-numeric value, FIXED_INPUT will > 
{ call the SOUND_ALARM procedure to produce an audible error > 

< signal, and the blinking value will remain unchanged, > 
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imp lenient 
const 


BLINK 


chr ( 

130 

) 

BRI0HTI 

= 

chr ( 

129 

> 

BRISHTBLINKI 


chr ( 

131 

) 

CLEARTOEOL 

= 

c hr ( 

009 

) 

CLEARTOEOM 


chr < 

011 

) 

FORMFEED 

= 

chr ( 

012 

) 

GOTOCOLZERO 

= 

c hr ( 

013 

) 

HALFBRIGHTI 


chr ( 

137 

) 

HOMEUPLEFT 

=: 

chr ( 

001 

) 

MOOEUPIROW 


chr ( 

031 

) 

NORMAL 


chr ( 

128 

) 

UNDERLINE 

= 

chr( 

132 

) 


type 

STRINGS = string [ S ] ; 


var 


RANDONSEED : RANDOMINT ; 
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procedure INITIALI ZE_I0 ; 
begin 

loinitialize; 

RANDOhSEED IMAX( 1, IHIN( maxint-1, CLOCKTICK ) ) ; 
end ; 


procedure CLEAN_UP_IO ; 
begin 

lounini t ial i ze ; 
end 


procedure CLEAR_LINE ; 
begin 

write ( GOTOCOLZERO,CLEARTOEQL ) ; 
end ; 


procedure CLhAR_SCRtEN ; 
begin 

write ( HOMEUPLEFT,CLEARTOEOM ) ; 
end ; 

procedure FETCHLN ( var STR : LINESTR ) ; 
begin 

readln ( STR ) ; 
end ; 


procedure LOITER ( hILLISECS : integer ) ; 
var 

TICK • integer ; 

TOCK • integer ; 

begin 

TOCK := Sysciock + < TICKSPERSEC * MILLISECS ) div 1000 ; 
repeat 

TICK := Sysciock ; 
until TICK > TOCK ; 


end ; 
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procedure M0UE_UP ; 
begin 

write ( MOUEUPIROW ) ; 
end ; 

procedure SET^BR IGHTBL INK_I NUERSE^U IDEO ; 
begin 

write ( BRIGHTBLINKI ) ; 
end ; 


procedure SET_HALFBRIGHT_INUERSE_UIDEO ; 
begin 

write ( HALFBRIGHTI ) ; 
end ; 


procedure SET_NORMAL_U IDEO ; 
begin 

write ( NORMAL ) ; 
end ; 


procedure SHOW ( STR : LINE5TR ) ; 
begin 

write ( STR ) ; 
end ; 


procedure SHOWLN ( STR : LINE5TR ) ; 
begin 

writeln ( STR ) ; 
end ; 


procedure SOUND_ALERT ; 

begin 
Beep ; 
end ; 


procedure SOUND_ALARM ; 
begin 

Beeper ( 3, 50 ) ; 
end ; 


¥7ARfi 1C7R 


p; 
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procedure START_NEUI_PAGE ; 
begin 

write ( LP, FORMFEED ) ; 
end ; 


procedure START^RANDOMLNUMBER^SEQUENCE ( SEED : RANDOMINT ) ; 
begin 

RANDOMSEED := SEED ; 
end ; 


function RANDOM^INTEGER : RANDOMINT ; 
var 

I • integer ; 

begin 

I RANDOMSEED ; 

Random ( I ) ; 

RANDOMSEED := I ; 

RANDOM^INTEGER := I ; 
end ; 


function CLOCKTICK • integer ; 
begin 

CLOCKTICK Sysclock ; 
end ; 


function CPUTICK : integer 
begin 

CPUTICK := Sysclock ; 
end ; 
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function DATESTRING = DATESTR ; 
type 


DAYARR = array C 0..6 1 of STRINGS ; 
NONARR = array [ 1 . , 12 1 of STRINGS ; 

const 


DAYNAME = DAYARR [ ’Sun’ , ’Mon’ , ’Tue’ , ’Wed’ , ’ Thu ’ , ’Fri ’ , ’Sat ’ ] ; 
NONNAME = NONARR C ’ Jan ’ , ’ Feb ’ , ’ Mar ’ , ’ Apr ’ , ’ Nay ’ , ’ Jun ’ , 

’ Jul’ , ’Auq’ , ’Sep’ , ’Oct ’ , ’Nov’ , ’Dec’ ] ; 

var 


D : integer 
DATE : Daterec 
K - integer 
JD : integer 
SECOND • integer 
TIME •• Tinerec 
WORK : DATESTR 
YR : integer 


begin 

Sysdate ( DATE ) ; 

Systine ( TIME ) ; 
with DATE, TIME do 
begin 

SECOND := round( Centisecond / 100 ) ; 

YR := 1900 + Year ; 

JD := JULIAN_DAYNUM( YR , Month, Day) ; 

D := ( JD + 1 ) mod 7 ; 

WORK ; 

strwrite ( WORK, 1, K, DAYNAMETD],’ ’ ) ; 
strwrite ( WORK, K, K, MONNAMEL Mont h ] , ’ ’ ) ; 


if 

Day < 

10 








t hen 

5 t rwr i t e 

( 

WORK , 

K, 

K, 

’0’,Day:l,’ ’ ) 



else 

strujr i t e 

( 

WORK , 

K, 

K, 

Day =2,’ ’ ) ; 


if 

Hour < 

10 








then 

struir i te 

< 

WORK , 

K, 

K, 

’0’ ,Hour: 1 , ’ : ’ : 

) 


else 

s trwr i te 

( 

WORK , 

K, 

K, 

Hour=2,’:’ ) ; 


if 

Minute 

< 10 








t hen 

struir i te 

( 

WORK, 

K, 

K, 

’0’ , Minute: 1 , ’ : ’ 

) 


else 

strwr i t e 

( 

WORK , 

K, 

K, 

Minute: 2, 


if 

SECOND 

< 10 








then 

strwr i te 

( 

WORK , 

K, 

K, 

’0’,SECOND:1,’ ’ 

> 


else 

s trwr 1 t e 

( 

WORK, 

K , 

f< 1 

SECOND: 2,’ ’ ) i 



struirite ( WORK, K, K, YR:4 ) ; 
end : 

DATESTRING := WORK ; 
end ; 
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function NAMESTRING ( PAG : NAMEPAC ) : NAMESTR ; 
var 

i : integer ; 

n : integer ; 

WORK : NAMESTR ; 

begin 

setstrlen< WORK, NAMELEN ) ; 
n : = 0 ; 

for i 1 to NAMELEN do 

if PACEi] <> ’ ’ then 
begin 

n : = n + 1 ; 

WORKCn] := PACm ; 
end ; 

setatrlen ( WORK, n ) ; 

NAMESTRING WORK ; 
end ; 


function UPPER_CASE< C : char ) • char ; 
var 

K : integer ; 

b e g i. n 

K ‘ - ord( C ) ; 

if K >= ord( ’a’ ) then 

if K <> ord( ’z’ ) then 

C •= chr( K + ord( ’A’ ) - ord( ’a’ ) ) 

UPPER__CASE := C ; 
end ; 


function CAPW0RD( WORD : WORDSTR ) : WORDSTR ; 
var 

i integer ; 
n : integer ; 

begin 

n := strlen( WORD ) ; 
if n > 0 then 

for i := 1 to n do 

WORDli] := UPPER_CASE( WORDE i ] ) 
CAPWORD := WORD ; 
end ; 
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function CHAR^INPUK WMODE : CHWAITMODE ; 

EMODE : CHECHOMODE ) : 


var 


S : string [ 1 ] 
WORK : CHINPUTREC 


begin 

case WMODE of 

NOCHWAIT : 
begin 

if Keybu f f er Si 2 e = 0 

then WORK.Q := NOTHING 

else 

begin 

Keybufops ( Kgetchar, WORK.C 
if WORK.C = chr( 013 ) 

then WORK.Q ENDOFLINE 

else WORK.Q SOMETHING 

end ; 


end ; 

CHWAIT : 
begin 

tjhile Keybuf f er . Si ze = 0 do 
WORK.C ^ ; 

Keybufops ( Kgetchar, WORK.C ) ; 
if WORK.C = chr( 013 ) 

then WORK.Q := ENDOFLINE 
else WORK.Q := SOMETHING ; 

end ; 

end ; < case WMODE > 
if WORK.Q <> SOMETHING then 
WORK.C ’ ’ ; 
if EMODE = CHECHO then 
begin 

setstrlen ( 5, 1 ) ; 

SCI] := WORK.C ; 

SHOW ( 5 ) ; 
end ; 

CHAR^INPUT := WORK ; 
end ; 


CHINPUTREC ; 
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function U5ER_DECIDES_T0( DO^THIS : PROMPTSTR ) : boolean ; 


var 

ANSWER : string! 3 ] 

OKAY : boolean 

WORK : CHINPUTREC 


begin 

SOUND^ALERT ; 
repea t 

SHOW ( DO_THIS+’ ? ’ ) ; 

WORK := CHAR_INPUT( CHWAIT, NOCHECHO ) ; 
OKAY := true ; 
if WORK.Q = ENDOFLINE 

then ANSWER ’YES’ 

else 

begin 

case WORK.C of 
’ Y ’ , ’ y ’ : 

ANSWER := ’YES’ ; 


’H’ , ’h’ , : 
begin 

OKAY false 
SOUND_ALARM ; 
end ; 


ot heruii se 
ANSWER := ’NO’ 


end ; { case WORK.C > 

end ; 


CLEAR_LINE ; 
until OKAY ; 

SHOW ( DO^THISf’ ? ’ ) ; 
SET_HALFBRIGHT_INUERSE_UIDEO ; 

SHOW < ’ ’+ANSWER+’ ’ ) ; 

SET^NORMAL^UIDEO ; 

SHOWLN ( ” ) ; 
if ANSWER = ’NO’ 

then USERJECIDES^TO { DO^THIS > false 
else USER_DECIDES_TO < DO^THIS > := true ; 


end ; 
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function WORD_INPUT( PROMPT : PR0MPT5TR ; 

DEFAULT : W0RD5TR ) : WORDSTR 


begin 

WORD_INPUT := RJWORD_INPUT( PROMPT, DEFAULT, 0, WORDLEN ) ; 
end ; 


function R JWORD^INPUT ( PROMPT 

DEFAULT 

FIELD 

MAXLEN 


var 


PROMPTSTR ; 

WORDSTR ; 
integer ; 

integer ) : WORDSTR 


base 

current 

DELIM 

FLD 

K 

LBRACE 

LEN 

OPTION 

RBRACE 

SELECT^MODE 

UALUE 

UALUE^APPROUED 

WERK 

WIRK 

WORK 


integer ; 
integer ; 
integer j 
integer ; 
integer ; 
integer ; 
integer ; 
array I 0. . 9 J 
integer ; 
boolean ; 
WORDSTR ; 
boolean ; 
CHINPUTREC ; 
LINESTR ; 
LINESTR ; 


of WORDSTR ; 
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begin i function RJWORD_INPUT } 

MAXLEN := IMIN( WORDLEN, MAXLEIM ) : 

WORK := strltrinl strrtrim( DEFAULT ) ) ; 

LEN := IMIN( MAXLEN, strlenl WORK ) ) ; 

DEFAULT := str< WORK, 1, LEN ) ; 

SELECT_MODE := false ; 

LBRACE := 5trpos( PROMPT, ) ; 

if LBRACE > 0 then 
begin 

RBRACE := strpos( PROMPT, ’}’ ) ; 

if RBRACE > LBRACE then 
beg i n 

SELECT_MODE := true ; 
base := 0 ; 

LEN := RBRACE - LBRACE ; 

WORK := 5tr( PROMPT, LBRACE+1, LEN ) ; 
repeat 

DELIM := strposi WORK, ’ , ’ > ; 
if DELIM = 0 then 

DELIM := strpos( WORK, ’}’ ) ; 

LEN := DELIM - 1 ; 

WIRK := strltrin( strrtrini str( WORK, 1, LEN ) ) ) : 

LEN := IMIN( MAXLEN, 5trlen( WIRK ) ) ; 

OPTIONEbase] := str( WIRK, 1, LEN ) ; 
strdelete( WORK, 1, DELIM ) ; 
base := base + 1 ; 
until strlen( WORK ) = 0 ; 
current := base ; 
repeat 

current •= current - 1 ; 

until ( OPTION! current ] = DEFAULT > or ( current = 0 ) : 
DEFAULT := OPTIONEcurrent 1 ; 
end ; 

end ; 

UALUE ;= DEFAULT ; 

SOUND_ALERT ; 
repeat 

SHOW ( PR0MPT+’ : ’ ) ; 

SET_BRI6HTBLINK_INUERSE_UIDE0 ; 

FLD := IMAX( FIELD, strlen! UALUE ) ) ; 

WORK : = " ; 

strwrite ( W0RK,1,K,’ ’, UALUE : FLD , ’ ’ ) ; 

SHOW ( WORK ) ; 

SET_NORMAL_UIDEO ; 


!fGB2FFECF 


■4- 3 
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if SELECT^MODE 

then 

begin 

WERK CHAR..JNPUT( CHWAIT, NOCHECHO ) ; 
if WERK.Q - ENDOFLINE 

then UALUE^APPROUED := true 

else 

begin 

UALUE^APPROUED := false ; 
if WERK.C in C 1 

then current — ( current - 1 ) nod base 
else current := ( current + 1 ) nod base ; 
UALUE :-■= OPTION[ current ] ; 
end ; 

CLEAR^LINE ; 
end 


else 

begin 

SHOWLN ( ” ) ; 

FETCHLN < WORK ) ; 
MOUE^UP ; 

CLEAR^LINE ; 

HOOE^UP ; 

CLEAR^LINE ; 
if strlen( WORK ) - 0 


then UALUE^APPROUED := true 

else 

begin 

UALUE^APPROUED := false ; 

WORK := strltrin( strrtrin( WORK ) ) ; 
LEN := strlen( WORK ) ; 
if LEN > NAXLEN 

then 

begin 

LEN := MAXLEN ; 

SOUND^ALARH i 
end 


else SOUND^ALERT ; 

UALUE := str( WORK, 1, L.FN ) ; 
end ; 


end ; 

until UALUE^APPROUED ; 

SHOW ( PR0NPT+’ : ’ ) ; 
SET_HALFBRIGHT_INUERSE_UIDEO ; 
WORK : - ” ; 


y QC Aonzi/^D 


>f >1 
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struirite ( W0RK,1,K,’ ’ , UALUE = FLD , ’ ’ ) ; 

SHOW ( WORK ) ; 

SET_NORMAL_UIDEO : 

5H0WLN ( ’ ’ ) ; 

RJWORD_INPUT := UALUE i 

end : i function RJWORD_INPUT } 
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function INTEGER_INPUT( PROMPT 

PROMPTSTR ; 


DEFAULT 

integer ; 


FIELD 

integer ) : 

integer 


var 

K 

- integer ; 

TRIAL_UALUE 

: integer : 

UALUE 

: integer ; 

UALUE_APPROUED 

; boolean ; 

WORK 

: LINE5TR ; 

begin 

UALUE := DEFAULT : 


SOUND_ALERT ; 


repeat 


SHOW ( PR0MPT+’ 


SET_BRIGHTBLINK_ 

.INUERSE^LiIDEO 


WORK ” i 

strwrite ( W0RK,1,K,’ UALUE : FIELD , ’ ’ ) ; 

SHOW ( WORK ) ! 

SET_NORMAL_UIDEO ; 

SHOWLN ( ” ) i 
FETCHLN ( WORK ) ; 

MOOE_UP ; 

CLEAR_LIIME ; 

MOUE_UP : 

CLEAR_LINE ; 
if strlen( WORK ) = 0 


then 

UALUE APPROUED := true 


else 
begi n 

UALUE_APPROUED := false ; 

try { set trap for possible error > 

strread ( WORK, 1, K, TRIAL_UALUE ) : {. error here naybe } 

UALUE := TRIAL_UALUE ; 

SOUND_ALERT ; < and jump around "recover" statement > 

recover SOUND_ALARM ; { come here after error, if any > 

end : 

until UALUE_APPROUED ; 

SHOW ( PROMPT+’ : ’ ) i 
SET_HALFBRIGHT_INUERSE_UIDEO ; 

WORK : = ” ; 

strwrite < W0RK,1,K,’ ’, UALUE : FIELD , ’ ’ ) ; 

SHOW ( WORK ) ; 

SET_NORMAL_UIDEO ; 

SHOWLIM ( ” ) : 

INTE6ER_INPUT := UALUE ; 

^nd • 


V 1 C-ZDAQ^Q 


✓I CZ2 
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function FIXED_INPUT( PROMPT 

DEFAULT 

FIELD 

PLACES 


PROMPTSTR ; 
longreal ; 
integer ; 

integer ) = longreal ; 


var 


K 

TRIAL_UALUE 

UALUE 

UALUE_APPROUED 

WORK 


integer 
1 ongrea 1 
longreal 
boolean 
LINESTR 


begin 

UALUE := DEFAULT ; 

SOUND_ALERT ; 
repeat 

WORK := ” i 

strwrite ( WORK, 1, K, UALUE = FIELD = PLACES > ; 
strread ( WORK, 1, K, UALUE ) : 

SHOW ( PR0MPT+’ : ’ ) ; 
SET_BRIGHTBLINK_INUERSE_UIDEO ; 

SHOW ( ’ ’+W0RK+’ ’ ) ; 

SET_N0RMAL_UIDE0 ; 

SHOWLN ( ” ) i 
FETCHLN ( WORK ) ; 

M0UE_UP ; 

CLEAR_LINE ; 

MOUEJJP ; 

CLEAR_LINE ; 
if strlen( WORK ) = 0 


then 

UALUE_APPROUED == true 

else 

begin 

UALUE_APPROUED == false ; 

try < set trap for possible error > 

strread ( WORK, 1, K, TRIAL_UALUE ) ; •{ error here maybe )• 

UALUE := TRIAL_UALUE ; 

SOUND_ALERT ; -i and jump around "recover" statement > 

recover SOUND_ALARM ; •( come here after error, if any } 

end ; 

until UALUE_APPROUED : 

SHOW < PR0MPT+’ 

5ET_HALFBRIGHT_INUER5E_UIDE0 ; 

WORK == ” i 

strwrite ( W0RK,1,K,’ UALUE = FIELD •• PLACES , ’ ' ) ; 

SHOW ( WORK ) ; 

SET_NORMAL_UIDEO ; 

cunuj M / » 1 \ . 

1 W WL-IM \ / , 

FIXED_INPUT := UALUE : 
end ; 
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end ; 


{ module UTILSPIF 8, File ’UTILSPIF.I’ > 
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$ page $ { begin File ’utilspif.I’ > 

Utility Software Unit for HP-'9000 Series 500 with HP-UX 5,0 Op Sys > 


module UTILSPIF : 

{ 

Subject 

: System/PASCAL Int 

erface > 





Domain 

: Universal 



} 




< 

NASA/JSC/MPAD/TRW 

Sam W 

ilson > 





Updated 

Thu Apr 10 2 

5:16:19 

1986 > 




{ 

This one 

module conta 

ins ail 

o f 

the 

sy stem-dependent 

} 


< 

data and 

PASCAL code 

needed 

for 

most 

app 1 icat ions . 

> 

import 









UTILMATH ; 










export 

const 


TICKSPERSEC - 60 


DATELEN 

- 24 ; 

< 

numb 

LINELEN 

= 80 ; 

{ 

max 

NAHELEN 

- 8 ; 


max 

PROMPTLEN 

It 

cn 

{ 

max 

UORDLEN 

= 20 ; 

•c 

max 


; i Series 

er of characters in dat 
characters in input/out 
characters in "name" st 
characters in prompt st 
characters in "word*' st 


500 clock resolution > 


e-and-time string > 
put line string > 
r ing > 
ring for user input > 
ring > 
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type 

RANDOMINT = 1 . . max in t *“ 1 j { pseudorandom integer : 1 .. 2 1 47483646 > 

DATESTR = string C DATELEN 1 ; 

LINESTR = string C LINELEN ] ; 

NAMEPAC = packed array C 1 , . NAMELEN 3 of char ; 

NAMESTR = string C NAMELEN ] ; 

PROMPTSTR = string [ PRONPTLEN 3 ; 

WORDSTR = string [ WORDLEN 3 ; 


CHWAITMODE = ( { describes wait mode for CHAR_INPUT function } 

CHWAIT, < wait if input buffer is empty > 

NOCHWAIT ) ; < don’t wait if input buffer is empty > 

CHECHOMODE = ( { describes echo mode for CHAR_INPUT function > 

CHECHO, { echo characters back to user terminal screen > 

NOCHECHO ) ; < don’t echo characters back to user terminal > 

GOTUIHAT = ( { describes result of executing CHAR_INPUT functn > 

NOTHING, { the input buffer was empty < & didn’t wait) > 

ENDOFLINE, { got an end-of-line char ( <RETURN> keystroke) } 

SOMETHING ); < got a character that was not end-of-line > 

CHINPUTREC - 

record i returned by the CHAR_INPUT function > 

Q : GOTWHAT ; { qualifier for the returned character > 

C : char ; < C = ’ ’ if Q = NOTHING or ENDOFLINE; > 

end ; < record > •{ else C = char produced by user keystroke > 


var 

LP : text ; < standard file for printed output; must be > 

{ opened by “rewrite" statement somewhere in > 
Tprogrambeforeuse > 
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procedure irslITIALI ZE.IO ; 

{ This procedure performs the I/O system initialization re~ > 
{ quired to support most applications. Normally it should be > 
{ the first procedure called by any program. > 

procedure CLEAN_UP_IO ; 

< This procedure closes any open files and generally cleans > 
{ up the I/O system. Normally it should be the last procedure } 

< called by any program. > 

procedure CLEAR_LINE ; 

{ This procedure clears the line on the user terminal where > 
{ the cursor is currently located. > 

procedure CLEAR_SCREEN ; 

{ This procedure clears the user terminal screen. > 

procedure FETCHLN < var STR : LINESTR ) ; 

< This procedure reads (and thus removes) characters from the > 

{ user terminal input buffer storing them in the string > 

< variable STR until an end-of-line character (generated > 

{ by a <RETURN>* keystroke) has been read. The end-of-line > 

< character is always discarded, along with any other charac- > 

{ ters in excess of the number (LINELEN) needed to fill the > 
{ variable STR to its maximum capacity. > 

T ♦ NOTE : Some keyboards, instead of having a <RETURN> key, } 

{ have an <ENTER> key that serves the same purpose. > 

{ Wherever "<RETURN>“ appears in this and following > 

{ descriptions, it should be interpreted as "<RETURN> > 

< or <ENTER>, whichever is present on the keyboard" . > 

procedure LOITER ( MILLISECS : integer ) ; 

< This procedure loops through meaningless code (effectively } 

{ suspending program execution) for the number of milliseconds > 
{ specified in its argument. > 
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procedure MOUE_UP ; 

{ This procedure moves the cursor up one line on the user > 

{ terminal . } 

procedure SET^BRIGHTBL INK_II\IUERSE_UIDEO ; 

{ This procedure causes characters to be ujritten on the user > 

{ terminal screen in the blinking bright inverse video mode, > 

{ which remains in effect until another mode is specified, > 


procedure SET^HALFBR IGHT_I NUERSE^UIDEO ; 

{ This procedure causes characters to be written on the user } 
< terminal screen in the halfbright inverse video mode, > 
{ which remains in effect until another mode is specified. > 


procedure SET^NORklAL^U I DEO ; 

{ This procedure causes characters to be written on the user > 

{ terminal screen in the normal video mode, which remains in > 

•C effect until another mode is specified. > 

procedure SHOW ( STR : LINESTR ) ; 

{ This procedure writes a PASCAL string to the user terminal. > 

procedure SHOWLN ( STR : LINESTR ) ; 

< This procedure writes a PASCAL s 
{ and then positions the cursor at 

< line. 


edure SOUND^ALERT ; 

This procedure causes an audible signal to be sounded at the } 
user terminal, often to indicate that the program is waiting > 
for input from the user, sometimes (in real-time simulators) > 
to indicate that the program is ignoring an attempted input > 
because it is not valid or not capable of timely implementa- } 
tion in the current circumstance . > 


{ 

< 

{ 

{. 

< 


tring to the user terminal, > 
the beginning of the next > 

> 


procedure SOUND__ALARN ; 


/ 

< 

{ 


This procedure 

r- -.4. 4.U^ 

owuiiu\=;lj c.1*/ 

error condition 
on the part of 


causes a distinctive audible signal to 
user terminal, usually to indicate that 
has occurred that requires corrective 
the user. 


be 

some 

action 


> 

> 

> 

> 



File ’utilspif.I’ Page 5 


Printed Wed Apr 16 00:05:37 1986 


$ pagei $ 


procedure START^NEW^PnGE ; 

{ This procedure causes a page-eject character to be written > 

< to the standard printed-output file LP, which must have been > 

< opened somewhere in the program with a "rewrite" statement. > 


procedure 5TART_RAND0h_NlJMBER_SEQUENCE ( SEED : RANDOMINT ) ; 

<. This procedure uses the argument SEED to initiate a repeat- > 
{ able sequence of pseudorandom numbers. > 

function RANDOM^I NTEGER : RANDOMINT ; 

{ This function returns a pseudorandom integer from a uniform } 
{ distribution in the range of 1 to MAXINT-1 (i.e., in the } 

< range of 1 to 2147485G4G). > 

function CLOCKTICK : integer ; 

T This function returns an integer corresponding to the number > 

< of "ticks" registered on the system clock since some arbi- > 

■C trary fixed time in the past. > 


function CPUTICK integer ; 

{ This function returns an integer number that grows at the > 

< rate of the expenditure of CPU time (measured in system > 

< clock "ticks") to support the calling process. > 


function DATESTRING : DATESTR ; 

< This function returns a PASCAL string describing the current > 

{ date and time in the form, e.g., "Tue Feb 18 17:32:25 198G", > 

function NAMESTRIN6( PAC : NAMEPAC ) : NAMESTR ; 

{ This function returns a PASCAL string formed by removing } 

{ any blank spaces found in the input PAC (packed array of } 

{ characters ) . > 


function UPPER_CASE( C : char ) : char ; 

< If C is a lower-case letter of the alphabet this function > 
{ returns its upper-case counterpart; otherwise it returns > 
{ C unchanged. } 
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function CAPWORD( WORD -* W0RD5TR ) : WORDSTR ; 

{ This function returns a string formed by replacing ail } 

{ lower-case letters in the input WORD (if any) with their > 

< upper-case count erpart s . } 

function CHAR_INPUT( WMODE : CHWAITMODE ; 

EMODE : CHECHOMODE ) : CHINPUTREC ; 

< If the user terminal input buffer is empty when this func- > 

< tion is called, it will will either wait for a character to > 

< be input or return immediately to the calling routine, de- > 
{ pending on whether the value of WMODE is CHWAIT or NOCHWAIT, > 

< Whenever it finds the buffer unempty, it removes one char- > 

{ acter and if the value of EMODE is CHECHO it echoes that > 

< character back to the user terminal. If WMODE = NOCHWAIT > 
{ and the input buffer is empty then the value of CHAR_INPUT.Q > 

< is NOTHING; if an end-of-line character is read from the > 

{ buffer (the result of the user having pressed the <RETURN> > 

< key) then the value of CHAR^INPUT.Q is ENDOFLINE; otherwise } 

{ the value of CHAR_INPUT.Q is SOMETHING and the value of > 

< CHAR_INPUT.C is the character that was read from the buffer. > 

{ CHAR_INPUT.C = ’ ’ (the space character) when the value of > 

< CHAR^INPUT.Q is NOTHING or ENDOFLINE. > 

function USER_DEC I DESOTO ( D0_THIS : PROMPTSTR ) : boolean ; 

< The D0_THIS input string should describe a tentative action, > 
{ and after appending the characters * ? ’ it should also form > 

< a question that can be answered "yss" or "no" by the user > 
{ (with a single keystroke, as explained below). The boolean > 

< value of this function is TRUE if the user’s answer is "yes" > 

{ and FALSE if the answer is "no". > 

< The USER_DECIDES_TO function code causes the D0_THIS string, > 

T followed by the characters ’ ? to be displayed on the > 

< user terminal screen in normal video mode, and then it waits > 

< for the user to press a single key indicating his decision. > 

< Pressing ’Y’, ’y’, or the <RETURN> key indicates "yes". If > 

< the user presses ’H’,’h’, or (thinking perhaps to obtain > 

i a further description of available options), the SOUND_ALARM > 
{ procedure is invoked to give an audible error signal. Any > 

< other keystroke is interpreted as "no". As soon as an an- > 
{ swer is received, an appropriate character string (’YES’ or > 

< ’NO’) is displayed in half-bright inverse video mode immed- > 

< iately behind the prompting question, and the correspondi ng > 

< boolean value (TRUE or FALSE) is returned to the calling > 

{ routine. > 


V/ r~ a rsr\ 
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function WORD_INPUT( PROMPT = PROMPTSTR ; 

DEFAULT : WQRDSTR ) : WORDSTR ; 

< The PROMPT string, folloued by the characters ’ = ’ , is dis- > 

{ played on the user terminal screen in normal video mode and } 

< followed on the same line by a display of the DEFAULT value > 

{ in blinking bright inverse video mode, signifying that the > 

<. user may approve the blinking value as shown or else supply > 
{ another value (which will replace the one currently blinking } 
{ and become the new value to be approved or replaced). When > 

{ satisfied with the blinking value, the user terminates the > 

{ input process with a single <RETURN> keystroke (i.e,, one > 

{ not that is not preceded by any other keystroke). This > 

<. causes the display mode of the blinking value to be down- > 
{ graded to steady half-bright inverse video, indicating its > 

< acceptance by the user. The user-approved value (a charac- > 

< ter string) is returned ( o‘n the stack) to the calling rou- > 

< tine as the value of the functon WORD_INPUT. > 

{ If the PROMPT string does not contain a pair of braces (like > 
"C the ones enclosing each of these comment lines), then the > 

< user may type in any character string of his choosing, } 

{ which must be terminated with a <RETURN> keystroke. After > 
{ deleting any leading or trailing blank spaces, and any other > 

< characters in excess of the number ( WORDLEN ) required to > 

{ fill the INPUT_WORD function value to its maximum capacity, > 

{ the value thus supplied will replace the previous blinking > 

< value on the user terminal screen. This cycle is repeated > 

{ until a blinking value is approved in the fashion described > 
{ in the preceding paragraph. > 

< Braces like the ones enclosing this line if present in > 

{ PROMPT contain a comma-separated list of the only chat — > 

■C acter strings that are permissable input values, from which > 
{ the user must make a choice. If the blinking value is not > 

< acceptable to the user, pressing the or the ’<* key will > 

{ cause its predecessor in the list to be displayed in the > 

< blinking mode for possible approval; pressing any other key > 

< except <RETURN> will cause its successor in the list to be > 

{ displayed instead. Running off the end of the list in > 

•C either direction causes a " wraparound" to the opposite end. > 
{ The maximum number of values allowed in the list is ten. > 

function R JWORD_INPUT( PROMPT = PROMPTSTR ; 

DEFAULT : WORDSTR ; 

FIELD : integer ; 

MAXLEN : integer ) = WORDSTR ; 

< This function works exactly like WORD_INPUT except that the > 

{ the usei — input "word", when displayed on the user terminal > 
{ screen, is r ight- j us t i f i ed in a space at least FIELD columns > 
i wide, and the length of the "word" is constrained to be no > 
{ greater than MAXLEN, > 
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function INTEGER_^INPUT( PROMPT -* PROMPTSTR ; 

DEFAULT : integer ; 

FIELD : integer ) : integer ; 

< This function works very much like RJWORD_INPUT except of } 
•{ course the function value is an integer instead of a string, > 
t which Makes the MAXLEN argument of RJWORD_INPUT inappropri“ T 

< ate in this case. If the user types in a number in fixed- > 
{ point decimal format, it is truncated to make it an integer } 

< (i.e,, the decimal point and any characters following it are > 
{ ignored). Any attempt on the part of the user to input a > 

< non-numeric value causes an audible error signal to be pro- > 
{ duced by the SOUND_ALARM procedure, and the blinking value > 

< remains unchanged, > 

function FIXED_INPUT( PROMPT : PROMPTSTR ; 

DEFAULT : longreal ; 

FIELD : integer ; 

PLACES : integer ) : longreal ; 

< This function is similar to I NTEGER_I NPUT except that the } 

< function value is a longreal number instead of an integer, > 
{ A fixed-point format is always used to display the function > 

< value on the user terminal screen, and the PLACES argument } 

< specifies how many digits are to be shown after the decimal } 

< point. If the user types in a number with more digits than > 

< what is called for by the PLACES argument , it is rounded to > 

{ the nearest decimal digit in the last place shown on the > 

{ screen. The same applies to the DEFAULT value supplied > 

•{ by the calling routine. Within the limits of precision that > 
{ are inherent in the trans f orma t i on between the binary and > 

< the decimal representat ion of a number, the function value } 

{ returned to the calling routine is exactly that which is > 

< shown to the user, with no significant decimal digits lurk- } 

< ing unseen beyond the last one displayed (i.e., "what you > 

< see is what you get”), > 

{ This function does not require user input to be typed in a > 

< fixed-point format. Integer format is acceptable for whole > 
{ numbers, and it is not necessary to type "0" before the dec- > 

< imal point of a fraction nor behind that of a whole number. } 

{ An exponential format may be used if that is the user’s > 

< preference. For example, the value displayed on the user > 

< terminal screen and returned to the calling routine > 

< as "150.00" may have been typed in by the user as "149.996", > 
{ "150", "150.", "1.5+2", "1.5e2", or " 1 . 499963L2 " . If the > 
{ user attempts to input a non-numeric value, rIXED_IMPUT will > 
I call the SOUND_ALARM procedure to produce an audible error > 

< signal, and the blinking value will remain unchanged. > 
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implement 
const 





DATEPACLEN = 

2G ; 



FORMFEED 

chr ( 

012 

) 

NEWLINE 

chr ( 

010 

) 

NULLCHAR 

chr ( 

000 

) 


type 

DATEPAC = packed array [ 1 . . DATEPACLEN 1 of char ; 
DATEPTR = "DATEPAC ; 

PAC2S6 = packed array C 1..25G 1 of char ; 

TMSREC = 


record 


UTIME 

integer 

STIME 

integer 

CUT I ME : 

integer 

CSTIME 

integer 

end i < 

record > 


var 

RANDOMSEED : RANDOklINT ; 


HP-UX 5.0 

system 

rout i nes 

called from 

this module^ 



f unc t ion 

ct i me 

( 

var 

SECONDS 

: integer 

) 

DATEPTR 

; external 

f unc t ion 

t imes 

( 

var 

TMS 

: TMSREC 

) 

integer 

; external 

procedure 

exit 

( 


STATUS 

: integer 

) 


; external 

procedure 

t ime 

( 

var 

SECONDS 

integer 

) 


; external 


{ C routines (defined in ’ u t i 1 sc i f . c ’ ) called from this module^ 


> 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

pruueuur^e 

function 


c lear 1 ine 

clearscreen 

fetchpac ( 

ioinitialize 

iouninitialize 

moveuplrow 

setbrightblinki 

set cbreak 

setcecho 

setcuiai t 

set ha 1 f bright i 

setnocbreak 

set nocecho 

set nocwai t 

set norma Iv i deo 

showpac ( 

buunua i er I 

kbdcharcode 


var PAC 


var PAC 


PAC256 ) 


PAC256 ) 


integer 


external 
external 
external 
ex t ernal 
external 
external 
external 
external 
external 
external 
external 
ex ternai 
external 
external 
external 
ex ternai 
external 
external 
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procedure INITIALI ZE^IO ; 
begin 

ioinitialize ; 

RAIMDONSEEO := IMAX( 1, IMIN( maxint'-l, CLOCKTICK ) ) ; 
end ; 


procedure CLEAN_UP_IO ; 
begi n 

louninitialize j 
end ; 


procedure CLEAR_LI1ME ; 
begin 

clearline ; 
end ; 


procedure CLEAR_SCREEN ; 
begin 

clearscreen ; 
end ; 


procedure FETCHLN ( var SIR : LINESTR ) 
var 


i : integer ; 

WORK : PAC25G ; 

begin 

fetchpac ( WORK ) ; 

5etstrlen( STR, 0 ) ; 

i := 0 ; 

repeat 

i : = i + 1 ; 

if WORKli] <> NULLCHAR then 
begin 

setstrlen ( STR, i ) ; 

STRlil := WORKCil ; 
end ; 

until ( WORKCil = NULLCHAR ) or ( i = LI HELEN ) 


end ; 



File ’utilspif.I 


Page 11 


Pr inted 


Wed Apr IS 00:05:37 1986 


$ page $ 


procedure LOITER ( I1ILLI5ECS : integer ) ; 
var 

TICK : integer ; 

TM5 : TH5REC ; 

TOCK : integer ; 

begin 

TOCK := times( TM5 ) + ( TICKSPER5EC ^ MILLISECS ) div 1000 ; 
repeat 

TICK := tines( TMS ) ; 
until TICK > TOCK ; 

end ; 


procedure M0UE_UP ; 
begin 

moveuplrow ; 
end ; 


procedure SET_BRIGHTBLINK_^INUER5E_0IDE0 ; 
begin 

setbrightbiinki ; 
end ; 


procedure SET_HALFBRIGHT„INUERSE_UI DEO ; 
begin 

sethal f bright i ; 
end ; 


procedure SET_NORMAL_UIDEO ; 
begin 

setnormalvideo ; 
end ; 


V c c o r 9 /I i7, r 


nr CD 
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procedure SHOW ( SIR : LINESTR ) ; 
var 

i : integer ; 

n : integer ; 

WORK : PAC256 ; 

begin 

n : = 5 tr len( SIR ) ; 
if n > 0 then 

for i : = 1 t o n do 

WORKli] := STRCi] ; 
WORKCn+11 NULLCHAR ; 
showpac ( WORK ) ; 
end ; 


procedure 5H0WLN ( SIR : LINESTR ) ; 
var 


1 : integer : 

n : integer j 

WORK : PAC256 ; 

beg i n 

n := strlen( SIR ) ; 
if n > 0 then 

for i := 1 to n do 

WORKC i ] : = STR[ 1 ] 
WORK[n+l ] NEWLINE ; 
WORKtn+2.1 := NULLCHAR ; 
showpac ( WORK ) ; 
end ; 


procedure SOUND_ALERT ; 
begin 

soundalert ; 
end ; 


procedure SOUND_ALARM ; 


begin 

SOUND^ALERT ; 
LOITER ( 400 ) ; 
SOUND^ALERT ; 
LOITER ( 200 ) ; 
SOUND_ALERT ; 

end i 
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procedure STARTJ^iEW_PAGE ; 
begin 

write ( LP, FORMFEED ) ; 
end ; 

procedure START_RAND0M_NUMBER_5EQUENCE ( SEED : RANDOMINT ) ; 
beg i n 

RANDOMSEED := SEED ; 
end ; 


function RANDOM^INTEGER : RANDOMINT ; 

begin { emulation of Series 200 pseudorandom number generator > 
RANDOMSEED := trunc( RM0D( ( RANDOMSEED * 16807L0 ), maxint ) ) ; 
RANDOM^INTEGER RANDOMSEED ; 
end ; 


function CLOCKTICK : integer j 
var 


IMS : TMSREC 


begin 

CLOCKTICK := times( TMS ) 
end ; 


function CPUTICK : integer ; 


var 


TMS : TMSREC ; 
TRASH : integer ; 


begin 

TRASH := times( TMS ) ^ 
with TMS do 

CPUTICK := UTIME + STIME + CUTIME + C5TIME ; 

end j 


vcTPOc^n /I c 


c: 1 
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function DATESTRING : DATESTR ; 
var 

i : integer ; 

POINTER : DATEPTR ; 
SECONDS : integer ; 

WORK : DATESTR ; 

begin 

time ( SECONDS ) ; 

POINTER ctime( SECONDS ) ; 
setstrlen ( WORK, DATELEN ) ; 
for i := 1 to DATELEN do 

WORK! i 3 P0INTER‘‘[i 3 ; 
DATESTRING := WORK ; 
end ; 


function NAMESTRING ( PAC : NAMEPAC ) 
var 


i : integer ; 

n : integer ; 

WORK : NAMESTR ; 

begin 

setstrlen( WORK, NAMELEN ) 

TT : = 0 ; 

for i :== 1 to NAMELEN do 

if PACCi] <> ’ ’ then 
begin 

n : = n + 1 ; 
WORKCnl PACE i 1 
end ; 

setstrlen ( WORK, n ) ; 
NAMESTRING WORK ; 
end ; 


: NAMESTR 
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function UPPER_CASE( C : char ) : char ; 
van 


K ♦* integer ; 


begin 

K : = ord( C ) ; 

if K >= ord( ’a’ ) then 

if K <= ord< ’z’ ) then 

C := chr( K + ord( ’A’ ) - ord( ’a’ ) ) ; 

UPPER^CASE := C ; 
end ; 


function CAPW0RD< WORD : WORDSTR ) : WORDSTR ; 
var 


i : integer ; 

n : integer ; 


begin 

n := strlen( WORD ) ; 
if n > 0 then 

for i 1 to n do 

WORDm := UPPER_CASE( WORD! i ] ) ; 
CAPWORD WORD ; 
end ; 
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function CHAR_INPUT( WMODE •* CHWAITMODE ; 

EMODE : CHECHOMODE ) 

var 

K : integer ; 

WORK : CHINPUTREC ; 

begin 

setcbreak ; 

if EMODE = NOCHECHO then 
setnocecho ; 

if WMODE = NOCHWAIT then 
setnocuait ; 

K := kbdcharcode i 

if ( WMODE - NOCHWAIT) and ( K = ~1 ) 

t hen 
begin 

IJORK.Q := NOTHING ; 

WORK.C ; 

end 

else 

begin 

WORK.C := chr( K ) ; 
if WORK.C = NEWLINE 

then 

begin 

WORK.Q := ENDOFLINE ; 

WORK.C : 

end 

else 

WORK.Q := SOMETHING ; 

end ; 

setcuiait ; 
setcecho ; 
setnocbreak : 

CHAR^INPUT := WORK ; 
end ; 


CHINPUTREC ; 
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function U5ER_DECIDE5_T0( D0_THIS : PROhPTSTR ) : boolean ; 


var 

ANSWER : string! 3 1 

OKAY : boolean 

WORK : CHINPUTREC 


beg i n 

SOUND_ALERT ; 
repea t 

SHOW < DO_THIS+’ 7 ’ ) ; 

WORK := CHAR_INPUT( CHWAIT, NOCHECHO ) ; 
OKAY := true ; 
if WORK.Q = ENDOFLINE 

then ANSWER ’YES’ 


el se 
begin 

case WORK.C of 
’Y’ , ’y’ : 

ANSWER := ’YES’ ; 


’H’ , ’h’ /?’ : 
begin 

OKAY := false ; 
SOUND^ALARN : 
end ; 


ot herwi se 
ANSWER := ’NO’ ; 

end ; { case WORK.C > 


CLEAR^L I NE ; 
until OKAY ; 

SHOW ( DO_THIS+’ ? ’ ) ; 
SET_HALFBRIGHT__INUERSE_OIDEO ; 

SHOW ( ’ ’+ANSWER+’ ’ ) ; 

SET_NORNAL_UIDEO ; 

SHOWLN ( ” ) ; 
if ANSWER = ’NO’ 

then USERJECIDES^TO < D0_THIS > := false 
else USER DECIDES^TO < DO^THIS } := true ; 


end ; 
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function WORD_INPUT( PROMPT : PROMPTSTR ; 

DEFAULT : UlORDSTR ) : WORDSTR ; 

begin 

WORD^INPUT := RJUORD_INPUT( PROMPT, DEFAULT, 0, WORDLEN ) 
end ; 


function RJWORD_INPUT( PROMPT 

DEFAULT 

FIELD 

MAXLEN 


PROMPTSTR 
UlORDSTR ; 
integer ; 
integer ) 


U0RD5TR 


var 


base 

integer 


current 

i nteger 


DELIM 

integer 


FLD 

i n t eger 


K 

integer 


LBRACE 

1 nt eger 


LEN 

i nt eger 


OPTION 

array [ 0..9 ] of WORDSTR 

RBRACE 

integer 


SELECT_MODE 

bool ean 


UALUE 

WORDSTR 


>JALUE_APPR00ED 

boolean 


WERK 

CHINPUTREC ; 

WIRK 

LINESTR ; 

WORK 

LINESTR ; 
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begin < function RJWORD_INPUT } 

MAXLEN := IMIN( WORDLEN, MAXLEN ) ; 

WORK strltrin( strrtrim( DEFAULT ) ) ; 

LEN := IMIN( MAXLEN, strleni WORK ) ) ; 

DEFAULT := str( WORK, 1, LEN > ; 

SELECT„MODE := false ; 

LBRACE := 5trpos( PROMPT, ’(’ ) : 

if LBRACE > 0 then 
begin 

RBRACE := strposi PROMPT, ) ; 

if RBRACE > LBRACE then 
begin 

SELECT_MODE := true ; 
base := 0 i 

LEN := RBRACE - LBRACE ; 

WORK := str( PROMPT, LBRACE+1, LEN ) i 
repeat 

DELIM : = strpos< WORK, ’ , ’ ) ; 

if DELIM = 0 then 

DELIM := strposi WORK, ’>’ ) : 

LEN := DELIM - 1 ; 

WIRK := strltrirni strrtrim( str< WORK, 
LEN := IMIN( MAXLEN, strleni WIRK ) ) ; 
OFTIONEbdsel := str( WIRK, 1, LEN ) : 
strdelete( WORK, 1, DELIM ) : 
base := base + 1 ; 
until strlen( WORK ) = 0 : 
current := base ; 
repeat 

current := current - 1 ; 

until ( OPT I ON [ current 1 = DEFAULT ) or 
DEFAULT := OPTION! current ] : 
end ; 

end : 

UALUE := DEFAULT ; 

SOUND_ALERT ; 
repeat 

SHOW ( PROMPT+’ : ’ ) I 

SET_BRIGHTBLINK_.INUERSE_UIDEO : 

FLO := IMAX( FIELD, strlen( UALUE > ) : 

WORK : = ” ; 

strwrite < WORK , 1 , K , ’ ’ , UALUE •• FLO , ’ ’ ) ; 

SHOW ( WORK ) ; 

SET_NORMAL_UIDEO : 


- 1— r- /*M— 


, LEN ) ) ) : 


current = 0 ) ; 
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if SELECT^HODE 


then 

begin 

WERK := CHAR_INPUT( CHWAIT, NOCHECHO ) ; 
if WERK.Q - ENDOFLINE 

then UALUE_APPROUED true 


else 

begin 

UALUE^APPRO^JED := false ; 
if WERK.C in [ 3 

then current := ( current - 1 ) nod base 
else current : == ( current + 1 ) nod base ; 
UALUE OPTION! current 3 ; 
end ; 


CLEAR_LINE ; 
end 

else 

begin 

SHOWLN ( ’ * ) ; 

FETCHLN ( WORK ) ; 

MOUE^UP ; 

CLEAR^LINE ; 

NOOE^UP ; 

CLEAR^LINE ; 
if 5trlen( WORK ) - 0 

then UALUE APPROUED true 


else 

begin 

UALUE^APPROUED false ; 

WORK := strltrin( strrtrin( WORK ) ) ; 
LEN := strlen( WORK ) ; 
if LEN > NAXLEN 


t hen 
begin 

LEN := MAXLEN ; 
SOUND__ALARM ; 
end 

else SOUND_ALERT ; 

UALUE := str( WORK, 1, LEN ) ; 


end ; 


SHOW ( PR0MPT+’ : ’ ) ; 
SET_HALFBRIGHT_INUERSE__UrOEO 
WORK : - ” ; 
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strwrite ( W0RK,1,K,’ ’ , WALUE = FLD , ’ ’ ) ; 

SHOW ( WORK ) : 

SET_NORMAL_UIDEO ; 

SHOWLN < ” ) ; 

RJWORD_INPUT := UALUE ; 

end ; { function RJWORD_INPUT } 
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function INTEGER_INPUT( PROMPT 

: PROMPTSTR ; 


DEFAULT 

integer ; 


FIELD 

Integer ) 

: integer 


var 


K : integer 
TRIAL_yALUE : integer 
UALUE : integer 
UALUE_APPROUED : boolean 
WORK : LIMESTR 


begin 

WALUE := DEFAULT ; 

SOUND_ALERT ; 
repeat 

SHOW ( PR0MPT+’ : ’ ) i 

SET_BRIGHTBL.INK_INUERSE._UIDEO ; 

WORK : = ” ; 

strwrite ( W0RK,1,K,’ UALUE : FIELD , ’ ’ ) ; 
SHOW ( WORK ) ! 

SET_NORMAL_UIDEO ; 

SHOWLN ( ” ) : 

FETCHLN ( WORK ) ; 

M0UE_UP i 
CLEAR_LINE : 

M0UE_UP ; 

CLEAR_LIME ; 
if strlen( WORK ) = 0 


t hen 

UALUE APPROVED := true 


else 

begin 

UALUE_APPROUED := false ; 

try { set trap for possible error } 

strread ( WORK, 1, K, TRIAL_UALUE ) ; { error here maybe } 

UALUE := TRIAL_UALUE : 

SOUND_AL.ERT ; { and jump around "recover" statement } 

recover SOUND_ALARM : { come here after error, if any } 

end ; 

until UALUE_APPROUED ; 

SHOW ( PR0MPT+’ : ’ ) : 

SET_HALFBRI6HT_INUERSE_UIDE0 ; 

WORK := ” ; 

strwrite ( W0RK,1,K,’ UALUE : FIELD , ' ’ ) : 

SHOW ( WORK ) ; 

SET_NORMAL_UIDEO ; 

SHOWLN ( ” ) ; 

INTE6ER_INPUT ■• = UALUE ; 
end : 
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function FIXED__INPUT( PROMPT 

default 

FIELD 

PLACES 


var 


PR0MPT5TR ; 
longreal ; 
integer ; 
integer ) 


longreal ; 


K 

TRIAL^UALUE 

UALUE 

UALUE^APPROUED 

WORK 


integer 
longreal 
longreal 
boo 1 ean 
LINESTR 


begin 

UALUE := DEFAULT ; 

SOLiND_ALERT ; 
repeat 

WORK : = ’ * ; 

strurite ( WORK, 1, K, UALUE : FIELD : PLACES ) ; 
strread < WORK, 1, K, UALUE ) ; 

SHOW ( PR0MPT+’ : ’ ) ; 
SET_BRIGHTBLINK^.INUERSE„UIDEO ; 

SHOW < » *+W0RK-f’ ’ ) ; 

SET_NORMAL_^UIDEO ; 

SHOWLN ( ” ) ; 

FETCHLN ( WORK ) ; 

MOUE^UP ; 

CLEAR^LINE ; 

MOUE^UP ; 

CLEAR^L I NE ; 
if strlen< WORK ) - 0 


then 

UALUE APPROUED true 


else 

begin 

UALUE^APPROUED := false ; 

try { set trap for possible error > 

strread ( WORK, 1, K, TRIAL_UALUE ) ; { error here maybe > 

UALUE TRIAL^UALUE ; 

SOUND_ALERT ; < and jump around "recover" statement > 

recover SOUND_ALARM ; { come here after error, if any > 

end ; 

until UALUE^APPROUED ; 

SHOW ( PR0MPT+’ : ’ ) ; 

SET_HALFBR I GH T_I NUERSE_UI DEO ; 

WORK : = ” ; 

strwrite ( W0RK,1,K,’ ^ UALUE : F lELD : PLACES , » ’ ) ; 

SHOW ( WORK ) ; 

SET_NORMAL_UIDEO ; 

c' I trvj II M / » 1 V 

jnuvvLH \ y , 

FIXED_INPUT := UALUE : 
end : 
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•i Utility Software Unit for HP-9000 Series 200/300/500 Computers > 


nodule UTILUEMO ; t Subject : Uectors, Euler angles, matrices, quaternions > 

{ Domain : Universal > 

{ NASA/JSC/MPAD/TRU Sam Wilson > 

< Updated Thu Apr 10 23:22:11 1986 > 

i mpor t 

UTILMATH , 

UTILSPIF ; 

export 

type 


EULARR = {a generic triad of Euler angles > 
array [ 1..3 3 of longreal ; { representing three sequential > 

{ rotations of a rigid body about > 
{ orthogonal axes fixed in the > 

< body i tsel f : > 
{ X axis - 1 = R = ROL } 
T Y axis - 2 = P = PCH > 
{ Z axis - 3 = Y = YAW . > 

< The array is indexed according > 
{ to the rotation number, NOT the > 
{ axis number. > 


EULPRY = EULARR ; 

{ 

Euler 

EULPYR = EULARR ; 

{ 

Eu ler 

EULRPR = EULARR ; 

{ 

Eu 1 er 

EULYRY = EULARR ; 

{ 

Eu 1 er 

UECTOR = 




array [ l.,3 3 of longreal ; 


MAT3X3 = 

array [ 1..3 ] of UECTOR 


DIAG3X3 = 

array C 1..3 3 of longreal , 
SYNN3X3 = 

array [ 1..6 3 of longreal ; 


angles for a PCH/ROL/YAW sequence > 
angles for a PCH/YAW/ROL sequence > 
angles for a ROL/PCH/ROL sequence } 
angles for a YAW/ROL/YAW sequence > 

{ a row matrix of vector compon- > 

< ents in a right-handed Carte- > 
{ Sian coordinate system. Index > 

< = coordinate axis number (phys- > 
{ ically) = matrix column number > 
{ ( mat hemat ical ly ) . > 

< a 3x3 matrix. The element in } 
i the ith row and the jth column > 
{ of matrix N can be addressed as > 

< Ii[i,j3. The ith row (a vector) > 
{ can be addressed as Mill. > 

{ the elements of a diagonal 3x3 > 
\ matrix H, stored in the order: > 
{ MCI, 13 , MC2,2] , M[3,33 . > 

{ the elements of a symmetric 3x3 } 


{ matrix M, stored in the order: > 

/ Mr 1 1 1 > 

•C M[2,l] , MC2.2] , } 

{ M[3,n , M[3,2] , M[3,3] . } 
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QUATERNION = 
record 

case boolean of 

false : ( S • longreai ; 

U : UECTOR ) 

true : ( H : longreai ; 

I : longreai ; 

J longreai ; 
K • longreai ) 

end ; { case and record > 


cons t 


{ a record containing the sea- } 

< lar and the vector parts of > 
{ a quaternion. The scalar > 
{ part of the quaternion Q can > 

; { be addressed as Q.S or Q.H, > 
{ and the vector part can be > 
■C addressed as Q.U , The in- > 

< dividual coraponents of the > 

; { the vector part can be ad- } 

< dressed as Q.U113, Q,U[2], > 

{ Q.UL3] or as Q.I, Q.J, Q.K . > 


ZERUEC = UECTOR 

[ 

ZERO, 

ZERO, 

ZERO ] : 



■C zero 

vector 

} 

XUNUEC = UECTOR 

t 

ONE, 

ZERO, 

ZERO ] : 

< 

unit 

vector , 

axis 1 

> 

YUNUEC = UECTOR 

[ 

ZERO, 

ONE, 

ZERO ] ! 

< 

unit 

vector , 

axis 2 

> 

ZUNUEC = UECTOR 

[ 

ZERO, 

ZERO, 

ONE ] : 

< 

unit 

vector, 

axis 3 

> 

ZER3X3 = MAT3X3 

[ 





< 

3x3 zero 

matrix 

> 


ZERUEC , 
ZERUEC , 
ZERUEC 3 ; 


IDN3X3 - NAT3X3 
XUNUEC , 
YUNUEC , 
ZUNUEC ] ; 


< 3x3 identity matrix > 


function EULDEG( E : EULARR 


: EULARR ; 


< EULDE6 converts a triad of Euler angles from radian measure > 

< to degrees. It is normally used to convert internal values > 

< to measurement units suitable for output. This function is > 

< unique in that angles output by every other routine in this > 

< module are measured in radians. > 


function EULRAD( E : EULARR ) : EULARR ; 

t This function converts a triad of Euler angles from degree > 

< measure to radians. It is normally used to convert external > 

< values supplied by the user to measurement units suitable > 

< for internal computations. EULRAD is unique in that the } 

{ input angles must of course be measured in degrees, whereas > 

< angles input to every other routine defined in this module > 

< must be measured in radians. > 


function D0TP( U , U : UECTOR ) : longreai 


< The value of this function is the dot (scalar) product of } 
•CthevectorsUandU. > 
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function UMAG( U : UECTOR ) : iongreal ; 

{ The value of this function is the scalar magnitude of the } 

< vector U. > 

function S)(\J{ S : Iongreal ; U : UECTOR ) : UECTOR ; 

< The value of this function is the product of the scalar S > 

< and the vector U. > 

function CRSP( U , W : UECTOR ) : SECTOR ; 

\ The value of this function is the cross product of the vec- } 

{ tors U and W; i.e., CRSP(U,W) = U x W . > 

function UDIF( U , W : UECTOR ) : UECTOR ; 

{ The value of this function is the difference of the vectors > 

< U and Wi i.e., UDIF(U,U) - U - W . } 

function USUM( U , W : UECTOR ) : UECTOR ; 

{ The value of this function is the sum of the vectors > 

< U and W, > 

function UXD( U : UECTOR ; D : DIAG3X3 ) = UECTOR ; 

< The value of this function is the product of the vector > 

{ (row matrix) U and the diagonal matrix D. That is to say, > 

< UXD(U,D) = U * M, where represents the matrix multipli- } 

{ cation operator and M represents D in its full 3x3 form. } 

function UXM< U : UECTOR ; M : MAT3X3 ) : UECTOR ; 

■C The value of this function is the product of the vector } 

< (row matrix) U and the matrix M, i.e., UXM(U,h) = U * M, } 

{ where represents the matrix multiplication operator. > 

function UXMT( U : UECTOR ; M : MAT3X3 ) : UECTOR ; 

\ The value of this function is the product of the vector > 

{ (row matrix) U and the transpose of the matrix M, i.e., > 

{ UXMT(U,M) = U * T, where represents the matrix multi- > 

i plication operator and T is the transpose of M. > 
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function MDIF( L , M : MAT3X3 ) : MAT3X3 ; 

< The value of this function is the difference of the roatrices > 

< L and fi;i.e.,MDIF(L,M) = L-~M. > 

function MSUM( L , M ^ MAT3X3 ) ^ MAT3X3 ; 

< The value of this function is the sum of the matrices > 

{ L and M. > 

function hXN( L , M : MAT3X3 ) : MAT3X3 ; 

{ The value of this function is the product of the matrices > 

{ L and M; i.e., MXM(L,M) = L * M , where ”**' represents the > 

i matrix multiplication operator, } 

function MXMT( L , M = MAT3X3 ) : MAT3X3 ; 

{ The value of this function is the product of the matrix L > 

< With the transpose of the matrix f1 ; i.e., MXMT(L,M) = L * T, > 

{ where represents the matrix multiplication operator and > 

{ T is the transpose of M. > 

function MTXM( L , M : NAT3X3 ) : MAT3X3 ; 

{ The value of this function is the product of the transpose > 

■C of the matrix L with the matrix M; i.e., MTXM(L,M) = T # M, > 

< where “ * represents the matrix mu 1 1 ip 1 i cat i on operator and > 

< T is the transpose of L. > 

function MINU( M : MAT3X3 ) : MAT3X3 ; 

< The value of this function is the inverse of the matrix M, > 
i which is computed by the INUERT_MATRIX procedure of module > 
{ UTILMATH, INUERT_MATRIX will abort program execution with > 

< an escapecode of 9901 if M is singular, and the value of > 

< MINU will be undefined. The reference to MINU should be > 

< embedded in a " t ry /recover “ construct if it is desired to > 

{ provide exception-handling code in the calling routine to > 

<. recover from such an eventuality. > 
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function IMATQ( T : MAT3X3 ) : QUATERNION ; 

< Given the inverse (which is equal to the transpose T) of the } 

< orthogonal matrix that transforms vector components from one > 

{ Cartesian coordinate system F to another Cartesian system G, > 
{. this function computes a quaternion describing an eigenaxis > 
{ rotation which (assuming the two systems to have a common > 

{ origin) would rotate the axes of system F into coincidence > 

< with the axes of system G, and returns that quaternion to > 
<. the calling routine as the value of IMATQ, 

{ This function is particularly useful for establjshing the > 
i angular relationship between a fixed reference system and } 
{ another system whose axes can be described in terms of unit > 

< vectors in the reference frame. For instance, if P0S_J and > 

< UEL_J are the position and velocity vectors of a satellite > 

i in the Mean of 1950.0 geocentric inertial system J, the U > 

{ and W axes of the satel 1 i t e-cent ered UUW coordinate system > 
T are parallel to P0S_J and POS_J x UEL_J , respectively. The } 
{ angular orientation of the UUW system H is defined with re- > 
T spect to J by the quaternion QJH, which can be determined by } 
{ the following sequence of statements that also determine MHJ > 

< (the matrix that transforms vector components from system H > 

{tosystemJ). > 

T > 

< ANGMOM^J := CRSP( POS^J , UEL_J ) ; > 

i MHJI31 := SXU( 0NE/UMAG( ANGMOMJ ), ANGMOM^J ) ; > 

{ MHJIl] 5XU< 0NE/UMA6( P0S_J ), P0S_J ) ; > 

< MHJI21 CRSP( MHJ13], MHJCl] ) ; > 

{ QJH IMATQ( MHJ ) ; > 

< > 

{ If the input matrix fails an orthogonal i ty test based on the > 
T value of UNITOL (see module UTILMATH) then this routine will > 
{ abort program execution with an escapecode of 9701, and the > 

< value of IMATQ will be undefined. The reference to IMATQ > 

< should be embedded in a " try/recover ” construct if it is > 

< desired to provide exception-handling code in the calling > 

< routine to recover from such an eventuality, > 
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PRYQ( PRY : EULPRY ) = QUATERNION ; 


{ The value of this function is a quaternion that describes an > 

< eigenaxis rotation (i.e., a single rotation of a rigid body > 

< about one suitably chosen axis) uihich has the sane final > 

< effect as the sequence of rotations defined by the input > 

< values of the PCH/ROL/YAW Euler angles. > 

< The vector part of the output quaternion is referenced to > 

< axes fixed in the rigid body, and it points in the direction > 

T of the eigenaxis rotation <i.e., in the direction that a > 

{ right-hand screw would travel linearly during a positive > 

< rotation about the eigenaxis). The scalar part is equal to > 

{ cos( A/2 ) and the nagnitude of the vector part is equal to > 

T sin( A/2 ), where A is the angle of rotation about the > 


{ eigenaxis. Thus it can be seen that the sun of the squares > 
T of the conponents of any quaternion used to define the ori- } 
{ entation of a rigid body nust be equal to 1.0 (unity). Such > 
■i a quaternion is said to be "normalized" and is sometimes > 

{ referred to as a "versor", but more often it is called a > 

< "unit quaternion". > 

{ When the "rigid body" is an imagined set of Cartesian axes > 

{ that is rotated about its origin from a state of coincidince > 

{ with the axes of one fixed reference system into a state of } 

< coincidence with the axes of another fixed reference system, > 

{ it follows from the preceding paragraph that all components > 
<. of the quaternion including the components of its vector > 

< part have identical values in both of the fixed systems. > 

< Furthermore, the quaternion that describes the inverse rota- > 

< tion (from the second fixed system to the first) can be ob- } 

< tained simply by reversing the sign on all components of the > 

{ vector part or, ai terna t i vely , by changing the sign of > 

{ the scalar part and leaving the vector part unchanged. > 

PYRQ( PYR : EULPYR ) = QUATERNION ; 

{ This function is identical to PRYQ except that the Euler > 

{ rotation sequence is PCH/YAW/ROL instead of PCH/ROL/YAW. > 


RPRQ( RPR : EULRPR ) = QUATERNION ; 

< This function is identical to PRYQ except that the Euler } 

{ rotation sequence is ROL/PCH/ROL instead of PCH/ROL/YAW. > 


YRYQ( YRY : EULYRY ) = QUATERNION ; 


T This function is identical to PRYQ except that the Euler 
{ rotation sequence is YAW/ROL/YAW instead of PCH/ROL/YAW. 


> 

> 
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function QPRY( Q : QUATERNION ) : EULPRY ; 

< The value of this function is a triad of Euler angles for a > 

T PCH/ROL/YAW rotation sequence having the same final effect > 

{ as that of the eigenaxis rotation which is defined by the > 
i unit quaternion Q. > 

function QPYR< Q : QUATERNION ) : EULPYR ; 

< The value of this function is a triad of Euler angles for a > 

{ PCH/YAW/ROL rotation sequence having the same final effect } 

< as that of the eigenaxis rotation which is defined by the > 

<unitquaternionQ. } 

function QRPR< Q : QUATERNION ) : EULRPR ; 

< The value of this function is a triad of Euler angles for a > 

{ ROL/PCH/ROL rotation sequence having the same final effect > 

< as that of the eigenaxis rotation which is defined by the > 

TunitquaternionQ. > 

function QYRY( Q : QUATERNION ) : EULYRY ; 

{ The value of this function is a triad of Euler angles for a > 

< YAW/ROL/YAW rotation sequence having the same final effect > 

t as that of the eigenaxis rotation which is defined by the > 
{ unit quaternion Q. > 

function QMAT( Q : QUATERNION ) : MAT3X3 ; 

< Given a unit quaternion Q describing an eigenaxis rotation > 

< which (assuming coincidence of origins) will rotate the axes > 
{ of Cartesian system F into coincidence with the axes of sys- > 
•V tem G, this routine computes the matrix M that transforms > 

< vector components from system F to system G, and returns it > 

< to the calling routine as the value of the function QMAT. > 

< For instance, if UEC_F is referenced to system F and UEC__G > 

< is the physically identical vector referenced to system G, > 
{ then UEC_G = UXN( UEC_F, QMAT( QFG ) ), where QFG i s a qua- } 

ternion that defines an eigenaxis rotation from F to G. > 

•C If the sum of the squares of the components of the input > 

< quaternion differs from unity by more than UNITOL (see mod- > 
t uie UTILMATH) then this routine will abort program execution > 

< with an escapecode of 9702, and the value of QMAT will be > 
t undefined. If it is desired to provide exception-handling > 

< code in the calling routine to recover from such an eventu- > 

< ality, the reference to QMAT should be embedded in a "try/ > 

•y r e C u V e r " C O n 5 t r‘ u C t . } 
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function QCXQ( P , Q -■ QUATERNION ) : QUATERNION ; 

{ The value of this function is the quaternion product of the > 

< conjugate of P with Q; i.e., QCXQ(P,Q) = C o Q , where "o" > 

{ (circle) represents the quaternion multiplication operator > 

< and C is the conjugate of P (the quaternion that results > 

< from reversing the sign on all components of the vector part > 

< of P). } 

function QXQ( P , Q : QUATERNION ) : QUATERNION ; 

< The value of this function is the quaternion product of P > 

{ with Q; i.e., QXQ(P,Q) = P o Q, where "o" (circle) repre- } 
-C sents the quaternion multiplication operator. > 

function QXQC( P , Q : QUATERNION ) : QUATERNION ; 

< The value of this function is the quaternion product of P > 

{ with the conjugate of Q; i.e., QXQC(P,Q) = P o C, where "o" > 

-( (circle) represents the quaternion multiplication operator > 

< and C is the conjugate of Q (the quaternion that results > 

< from reversing the sign on all components of the vector part > 

T of Q). > 

function UNIQUAT( Q : QUATERNION ) : QUATERNION ; 

{ This routine normalizes the quaternion Q by computing the 
{ sum of the squares of all its components, and then dividing > 
{ each of them by the square root of that sum. The result is > 

< returned to the calling routine as the value of UNIQUAT. > 

{ Normal izat ion is required after each update of a (nominally) > 

< unit quaternion (such as one being used to define the ori- > 

< entation of a rigid body) when it is being integrated numer- > 

< ically on a component -by-component basis (i.e., when the > 

< components are being integrated as if they were separate > 

{ scalar variables). > 
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function R0T( U : UECTOR ; Q : QUATERNION ) : UECTOR ; 

< Given a vector U referenced to a Cartesian frame F, and a > 
{ unit quaternion Q defining the orientation of another frame > 
i 6 with respect to F, this routine transforms U from F to G > 

< and returns the transformed vector to the calling routine > 

■C as the value of ROT. In terms of quaternion operations, } 

R0T(U,Q) = C o U o Q, where "o” (circle) represents the qua- > 
{ ternion multiplication operator, C represents the conjugate } 

< of Q, and U is treated as a quaternion whose scalar part is } 

{ zero. In terms of the equivalent matrix operations , } 

<. R0T(U,Q) = UXM( U, QNAT( Q ) ), which represents the actual > 
{ method of computation used in this routine. > 

T If QFG is the name of the af orement ioned quaternion in the > 

< calling routine, and if UEC_F is the name of the vector > 

{ when it is referenced to frame F, then the statement } 

< > 

< UEC_G := R0T( UEC_F, QFG ) ; > 

{ > 

{. yields the value of the vector when referenced to frame G. > 
•{ When more than one vector is to be transformed, e.g., > 

T > 

{ P0S_G R0T( POS_F, QFQ ) ; > 

{ UEL^G := R0T( UEL^F, QFG ) ; > 

< > 

< faster execution will be realized by the statement sequence > 

< > 

{ MFG := QN AT ( QFG ) ; > 

< P0S_G := UXN( P0S_F, MFG ) ; > 

< UEL__.G UXM( UEL„F, NFG ) ; > 

{ } 

{ which minimizes the overhead associated with forming the > 

{ t rans f orma t i on matrix from the quaternion. } 
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function IR0T< U : UECTOR ; Q : QUATERNION ) : UECTOR ; 

< IROT is the inverse of the ROT function. That is, given a > 

i vector U referenced to a Cartesian frame G, and a unit > 

< quaternion Q defining the orientation of G with respect to > 

< another frame F, this routine transforms U from G to F > 

< and returns the transformed vector to the calling routine > 

■C as the value of IROT. In terms of quaternion operations, > 

{ IR0T(U,Q) = Q o U o C, where "o” (circle) represents the > 

< quaternion multiplication operator, C represents the conju- > 

< gate of Q, and U is treated as a quaternion whose scalar > 

< part is zero. In terms of the equivalent matrix operations, > 

{ IR0T(U,Q) = UXHT( U, QNAT( Q ) ), which represents the ac- } 

< tual method of computation used in this routine. > 

< If QFG is the name of the a f orement i oned quaternion in the > 

T calling routine, and if UEC_G is the name of the vector > 

{ when it is referenced to frame G, then the statement > 

< > 

{ UEC^F := IR0T( UEC^G, QFG ) ; > 

< > 

\ yields the value of the vector when referenced to frame F. > 

<. When more than one vector is to be transformed, e.g., > 

< > 

•{ POS^F := IROT( P0S_G, QFQ ) ; > 

< UEL^F := IROT( UEL_G, QFG ) ; > 

< > 

{ faster execution will be realized by the statement sequence > 

< > 

{ MFG QMAT( QFG ) ; } 

< P0S_F := UXMT( P0S_G, NFG ) ; } 

{ UEL_F UXMT( UEL__G, NFG ) ; } 

< > 

< which minimizes the overhead associated with forming the > 

i transformat ion matrix from the quaternion, > 
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procedure D 


< 

< 

{ 

< 

< 

< 

< 

{ 

< 

< 

< 


lAGONALIZE ( S 

TOLRATIO 
var D 
var M 


SYI1M3X3 ; 
longreal ; 
DIAG3X3 ; 
MAT3X3 ) ; 


This procedure calls the DI AGONALI ZE_5YMHATRIX procedure of 
nodule UTILMATH, which uses the Jacobi method of iteration 
to find an orthogonal matrix M that will ( approx imat ely ) 
transform an unknown diagonal matrix D into the symmetric 
matrix 5 by use of the equation S = T * D * M, where is 

the matrix mul t ip 1 icat ion operator and T is the transpose of 
M- Iteration ceases when a value of M is found such that 
every off-diagonal element of D’ = M * S * T (which is an 
approximation of D), has an absolute value no greater the 
product of the input parameter TOLRATIO with the root-mean- 
square magnitude of the diagonal elements of D. After the 
convergence test is satisfied, the diagonal elements of the 
approximation D’ are returned to the calling routine as the 
components of the output variable D, along with the final 
value of the t rans format i on matrix M. 


> 

> 

> 

} 

> 

> 

} 

> 

> 

> 

> 

> 

} 

} 

> 


< If NERTENS_B is a symmetric 3x3 matrix representing a rigid- > 

i body inertia tensor referenced to an arbitrary body-fixed > 
{ Cartesian frame B, then the two statements > 

< > 

{ DIAGONALIZE ( NERTENS_^B, 1.0L-6, NERTENS^P, MPB ) ; > 

< PYRBP := QPYR( TNATQ( MPB ) ) ; > 

{ > 

< yield the principal moments of inertia (the three components > 
{ of the diagonal matrix NERTEN5_P ) to a numerical accuracy > 
•C of approximately one part in a million, plus the PCH/YAW/ROL > 

< Euler angles (PYRBP) that define the orientation of the > 

< principal axes of inertia with respect to the B system. MPB > 
{ is a coordinate transf ormat ion matrix that can be used to > 

< transform vectors from reference system P (whose axes coin- > 

< c i de with the principal axes of inertia) to system B. > 

< If D’ has not converged to the specified tolerance after 150 > 
{ iterations, the values of M and D are NOT returned to the > 

< calling routine, and DIAGONALI ZE_SYMMATRIX will abort pro- > 
{ gram execution with an escapecode of 9902. The reference to > 
i DIAGONALIZE should be embedded in a " t ry /recover " construct > 

< if it is desired to provide exception-handling code in the > 

■C calling routine to recover from such an eventuality. > 
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implement 

const 

HALF = 0.5L0 J 

function EULDEG( E : EULARR ) : EULARR ; 
var 

j : integer ; 

begin 

for j := 1 to 3 do EULDEGCj] ANGDEG( E[jl ) ; 
end ; 

function EULRAD( E : EULARR ) = EULARR ; 
var 

j : integer ; 

begin 

for j := 1 to 3 do EULRADEj] := ANGRAD( ECj] ) ; 
end ; 

function D0TP( U , U : UECTOR ) : longreal ; 
begin 

DOTP := Um * WEI] + UC21 * WC21 + UE3] WC3] ; 
end ; 
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function UMAG( U : UECTOR ) : longreai ; 
begin 

UMAG := sqrt( sqr( U[ 1 3 ) + sqr( UC21 ) + sqr( UC33 ) ) ; 
end ; 


function SXU( S = longreai ; ‘J : UECTOR ) : UECTOR ; 


var 

j - integer ; 

begin 

for j := 1 to 3 do SXUEj] := S * UCj] ; 
end ; 


function CRSPv U , W : UECTOR ) : UECTOR ; 
begi n 

CRSPCn := U[2] * WC33 - WC2] * UC33 ; 

CRSP123 UC3] * Wm - W13] ♦ U[ 1 3 ; 

CRSPC53 := U[13 WE23 - WCll * UC23 ; 

end ; 
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function UDIF( U , W : UECTOR ) : UECTOR ; 
van 


j •' integer ; 


begin 

for j •= 1 to 3 do UDIF[j] ■= U[j] - W[j] ; 
end ; 


function USUH( U , U : UECTOR ) : UECTOR ; 
var 


j « integer ; 


begin 

for j := 1 to 3 do USUMCj] := UCjl + U[j3 
end i 



File MJtilvenq.T’ Page 15 


Printed Wed Apr 16 09:15:20 1986 


$ page $ 


function UXD( U : UECTOR ; D : DIAG3X3 ) : UECTOR ; 
var 

j : integer ; 

begin 

for j := 1 to 3 do UXDCj] KJlj] * DC j 1 ; 
end ; 


function UXM( U : UECTOR ; M : MAT3X3 ) : UECTOR ; 
var 

i : integer ; 

j : integer ; 

Ul : UECTOR ; 

begin 

W ZERUEC ; 
for j := 1 to 3 do 

for i := 1 to 3 do 

W[ j ] W[j ] + U[i ] * M[ i ,j ] ; 

UXM := W ; 
end ; 


function UXMT( U = UECTOR ; M : MAT3X3 ) : UECTOR ; 


var 

i : 

integer ; 

j • 

integer ; 

Ui : 

UECTOR ; 

begin 

W := ZERliEC ; 

for j := 

1 to 3 do 

for 

i := 1 to 3 do 
WEj] := ui[j] + UCil 


UXMT W ; 
end ; 
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function HDIF( L , M : MAT3X5 ) : MAT3X5 ; 
var 

i : integer j 
j : integer ; 

N : MAT3X3 ; 

begin 

for i := 1 to 3 do 

for j := 1 to 3 do 

N[i,j] := L[i,j] - ; 

NDIF := N ; 
end ; 


function MSUM( L , M : MAT3X3 ) : MAT3X3 ; 
var 

i : integer ; 
j : integer ; 

N : MAT3X3 ; 

begin 

for i := 1 to 3 do 

for j := 1 to 3 do 

NCi,j] := LCi.j] + M[i,j] ; 
MSUM N ; 
end ; 


V n7 aCc 1 Qc 
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function MXM< L , M : MAT3X3 ) : MAT3X3 ; 
var 

i : integer ; 
j : integer ; 

k : integer ; 

N : MAT3X3 ; 

h e g i ri 

N ZER3X3 ; 
for i 1 to 3 do 

for j :== 1 to 3 do 

for k := 1 to 3 do 

NCi,j] := NCi,j] + L[i,k] * MCk,j] ; 

MXM N ; 
end ; 


function MXMT( L , M : MAT3X3 ) : MAT3X3 ; 
var 

i : integer ; 

j : integer ; 
k : integer ; 

N : MAT3X3 ; 

begin 

N := 2ER3X3 ; 
for i := 1 to 3 do 

for j := 1 to 3 do 

for k := 1 to 3 do 

N[i,j] N[i,j] + LCi,k] * riCj,k] 

MXMT := N ; 
end ; 


function MTXM( L , M : MAT3X3 ) : MAT3X3 ; 
var 

i : integer ; 
j : integer ; 
k : integer ; 

N : MAT3X3 ; 

begin 

N := ZER3X3 J 
for i := 1 to 3 do 

for j : = 1 to 3 do 

for k := 1 to 3 do 

MTi --T blr - 1 1 *ri -T irfrt .1 

iM L X , J J - - iM L 1 , J i T u L r , i J n L K , J J ; 

MTXM N : 
end ; 
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function MINU( M : MAT3X3 ) : MAT3X3 ; 


var 


N : MAT3X3 ; 


begin 

INUERT^MATRIX ( M, 3, N ) 
mW N ; 
end : 


function IMATQC T : MAT3X3 ) : QUATERNION ; 


var 

F 

i 

j 

R 

SAUE 

TEST 


longreal 

integer 

integer 

1 ongrea 1 

longreal 

longreal 


begin < function INATQ > 
for i := 1 to 3 do 

for j i to 3 do 
begin 

TEST := D0TP( TCi], T[j] ) ; 
if i = j then TEST := TEST - ONE 
if abs( TEST ) > UNITOL then 
escape( 9701 ) ; 

end ; 

TEST := ONE + T[l,l] + TC2,2] + TC3,3] ; 
if TEST >= ONE 


abort program execution > 


then 

begin { H comp > 

R := sqrt( TEST ) ; 

IMATQ.H HALF * R ; 

F HALF / R ; 

INATQ.I := ( T[2,31 - T15,2] ) * F ; 

IMATQ. J := ( TC3, 1 ] - T[ 1 ,3} ) * F ; 

IMATQ.K ( TCI, 2] - T[2,l.l ) ♦ F ; 

end < H comp } 

else 

begin { I test > 

SAUE TWO - TEST ; 
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TEST := SAUE + TWO * Til, 11 : 
if TEST >= ONE 


then 

begin { I corop > 

R := sqrt( TEST ) ; 

IMATQ.I := HALF * R ; 

F := HALF / R ; 

IMATQ.J := ( T[2,n + Ttl,21 ) * F ; 

IMATQ.K := ( T[3,n + TCI, 31 ) * F : 

IMATQ.H := ( TE2,3] - T[3,21 ) # F : 

end { I comp } 

else 

begin < J test > 

TEST := SAUE + TWO * T12,2] : 
if TEST >= ONE 


then 

begin < J comp > 

R := sqrt( TEST ) ; 

IMATQ.J := HALF * R ; 

F := HALF / R ; 

IMATQ.K := ( TI3,2] + T[2,31 ) » F ; 

IMATQ.H := ( TI3,1] - Til, 31 ) ♦ F ; 

IMATQ.I := ( T[l,2] + T[2,1I ) * F ; 

end { J comp > 


else 


begin T K comp } 

TEST := SAUE + TWO * T[3,31 ; 

R := sqrt( TEST ) ; 

IMATQ.K := HALF * R ; 

F := HALF / R ; 

IMATQ.H := ( Til, 21 - T[2,l] ) * F : 

IMATQ.I := ( Til, 31 + TI3,1] ) * F ; 

IMATQ.J := ( TC2,31 + T[3,21 ) ♦ F ; 

end ; < K comp > 


end : { J test > 


end ; { I test > 


end : { function IMATQ > 


VDQ 1 1 AA'X 1 


a i 
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function PRYQ( PRY : EULPRY ) : QUATERNION ; 
var 

C : array [ 1..3 ] of longreal 

HAFAN6 : longreal ; 

n : integer ; 

S : array [ 1..3 ] of longreal 

begin 

for m := 1 to 5 do 


begin 
HAFANG := 

HALF » 

PRYEml 

f 






CCm] 

: = 

cos( HAFANG ) 

i 






S[n] 

: = 

sin( HAFANG ) 

» 






end i 










PRYQ.H := 

C[ 1 ] 

o 
1 — 1 

» C[3] 

+ 

S[ 1 ] 

* 

SC2] 

* 

SC3] 

PRYQ.I := 

CEl ] 

• S[23 

* CE3] 

+ 

SC 1 ] 

* 

CC2] 

* 

SC33 

PRYQ.J := 

S[ 1 ] 

* CC2] 

* CC3] 


CC 1 ] 

* 

SC2] 

* 

SC3] 

PRYQ.K := 

C[ 1 ] 

* C[2] 

* SC3] 

- 

sc 1 ] 

* 

SC2] 


CC3] 


end ; 


function PYRQ( 

PYR ; EULPYR 

) : QUATERNION ; 

var 

c 

array [ 1 . 

.3 1 of longreal 

HAFANG 

: longreal ; 


m 

: integer ; 


S 

: array [ 1 . 

.3 1 of longreal 


begin 

for m := 1 to 3 do 
begin 

HAFANG := HALF * PYRlml 
C[m 3 := cos( HAFANG ) 
SEm] := 5in( HAFANG ) 
end ; 


PYRQ.H 

:= cm 

* 

CC2] 

* 

CE31 

- sm 

* 

SE2] 

* 

SE31 

PYRQ. I 

:= CE 1 ] 

* 

CC2] 

* 

SC31 

+ sm 

* 

SE21 

*• 

CE3] 

PYRQ. J 

SEll 


CC2] 

* 

CE3] 

+ CE 1 ] 

* 

SE21 

* 

SE31 

PYRQ.K 
end ; 

:= CEl] 

* 

SC2] 

* 

CE31 

~ sm 

* 

CE21 

* 

SE31 


vpccc7Anc: 
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function RPRQ( RPR = EULRPR ) : QUATERNION ; 


var 


C : longreal 
HAFDIF : longreal 
HAFMID : longreal 
HAFSUM : longreal 
S •• longreal 


begin 

HAFMID := HALF * RPRC21 ; 

C := cos( HAFMID ) ; 

S := 5in( HAFMID ) ; 

HAFDIF := HALF * ( RPRCII - RPRC3] ) ; 

HAFSUM := HALF * ( RPRIll + RPRI31 > ; 

RPRQ.H := C * cos( HAFSUM ) ; 

RPRQ.I := C * sin( HAFSUM ) ; 

RPRQ.J := S ♦ co5( HAFDIF > : 

RPRQ.K := S # 5in< HAFDIF ) : 

end : 


ion YRYQ( YRY : 

: EULYRY 

van 



: QUATERNION ; 


C : longreal 
HAFDIF : longreal 
HAFMID : longreal 
HAFSUM •• longreal 
S : longreal 


begin 

HAFMID 

C 

S 

HAFDIF 
HAFSUM 
YRYQ.H 
YRYQ.I 
YRYQ. J 
YRYQ.K 
end ; 


HALF ♦ YRYI2I 
cos( HAFMID ) 
5in< HAFMID ) 


HALF * ( 

YRYI 1 ] 

~ 

YRYI3] ) 

HALF * < 

YRYI 1 ] 

+ 

YRYI3] ) 

C * C05< 

HAFSUM 

) 


S * cos( 

HAFDIF 

) 


S * sin( 

HAFDIF 

) 


C * sin( 

HAFSUM 

) 



C 


q?RF^PAF 


t=l ns; 
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function QPRY( 0 : QUATERNION ) : EULPRY : 


var 


Y 

Z 

QPRY 
QPRY 
QPRY 
end ; 


HAFDIF 

• longreal 

HAFSUM 

: longreal 

X 


: longreal 

Y 


: longreal 

Z 


• longreal 

begi n 
HAFDIF 


ATAN2( Q.J 

HAFSUM 

: = 

ATAN2( Q.J 

X 

: = 

sqr( Q.H ) 


cn 

[23 

[33 


TWO 

TWO 


Q.I 

Q.H 


Q.K , Q.H + Q.I ) ; 
Q.K , Q.H - Q.I ) : 
sqr( Q.I ) + sqr( Q. 
t Q.J + Q.H'»Q.K ) ; 
^Q.I-Q.J*Q.K ); 


J ) 


ANG2< HAFSUM + HAFDIF ) ; 

ATAN2( Z, 5 qrt< sqr( X ) + sqr< Y ) 
ANG2( HAFSUM - HAFDIF ) ; 


function QPYR( Q ; QUATERNION ) = EULPYR : 


var 


HAFDIF 

HAFSUM 

X 

Y 

Z 


longreal 

longreal 

longreal 

longreal 

longreal 


begin 

HAFDIF 

HAFSUM 

X 

Y 

Z 

QPYR C13 
QPYR [23 
QPYR [33 
end ; 


ATAN2( Q.J - Q.I , Q.H - Q.K ) ; 
ATAN2( Q. J + Q. I , Q.H + Q.K ) : 
5 qr( Q.H > - sqr( Q.I ) + sqr( Q.J) 
TWO* (Q.J* Q.K -Q.H *0.1 ); 
TWO*(Q.H*Q.K+Q.I*Q.J >: 
AN62( HAFSUM + HAFDIF ) : 

ATAN2( Z, sqrt( sqr( X ) + sqr( Y ) 
ANG2( HAFSUM - HAFDIF ) : 


- sqr( Q.K ) ; 


) > ; 


sqr( Q.K ) ; 


) ; 


vcai A f?iO □ A 


cn 
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function QRPR( Q : QUATERNION ) : EULRPR 


var 


HAFDIF 

: longreal ; 



HAFSUM 

: longreal ; 



X 

: longreal ; 



Y 

: longreal ; 



Z 

: longreal ; 



begin 




HAFDIF 

ATAN2( Q.K , 

Q,J ) ; 


HAFSUM 

ATAN2( Q.I , 

Q.H ) ; 


X 

sqr( Q.H ) + 

sqr ( Q . I 

) 

Y 

sqr( Q-J ) + 

sqr( Q.K 

) 

QRPR [1] := 

ANG2( HAFSUM 

+ HAFDIF 

) 

QRPR [2] := 

TWO ATAN2( 

sqrt( Y ) 

1 

QRPR C3] := 

ANG2( HAFSUM 

- HAFDIF 

) i 

end : 





function QYRY( Q : QUATERNION ) : EULYRY 


var 


HAFDIF 

: longreal ; 


HAFSUM 

: longreal * 


X 

: longreal ; 


Y 

: longreal i 


Z 

: longreal ; 


begin 



HAFDIF 

ATAN2( Q.J , 

Q. I ) ; 

HAFSUM :== 

ATAN2( Q.K , 

Q.H ) ; 

X 

sqr( Q.H ) + 

s q r ( Q.K ) 

Y 

sqr ( Q . I ) + 

sqr( Q.J ) 

QYRY [11 := 

ANG2( HAFSUM 

+ HAFDIF ) 

QYRY [2] := 

TWO ♦ ATAN2( 

5qrt( Y ) 

QYRY [31 := 

ANG2( HAFSUM 

- HAFDIF ) 

end ; 




sqrt( X ) ) ; 


sqrt( X ) ) ; 


^nf7iPR7n«R 
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function QMAT( Q : QUATERNION ) : MAT3X3 ; 


var 


A 

longreal 

B 

longreal 

C 

longreal 

G 

longreal 

H 

longreal 

I 

longreal 

J 

longreal 

K 

longreal 

X 

longreal 

Y 

longreal 

Z 

longreal 

begin 


A sqr( Q.I ) ; 

B := sqr( Q.J ) ; 

C := sqr( Q.K ) ; 

G := sqr( Q.H ) ; 


if abs( G + A + B + C - ONE ) > UNITOL then 

escape ( 9702 ) ; { abort program execution } 

H—6-A-B-C; 

I := TWO * Q.H » Q.I ; 

J :=TW0*Q.H*Q,J : 

K := TWO * Q.H ♦ Q.K ; 

X := TWO * Q.J * Q.K ; 

Y := TWO * Q.K ♦ Q.I ; 

Z := TWO * Q.I ♦ Q.J ; 

QMAT [1,1] :=H+A+A ; 

QMAT [1,2] := Z - K ; 

QMAT [1,3] := Y + J ; 

QMAT [2,1] := Z + K ; 

QMAT [2,2] :=H+B+B : 

QMAT [2,3] := X - I ; 

QMAT [3,1] := Y - J ; 

QMAT [3,2] := X + I i 

QMAT [o,3] -=H+C+C ; 
end ; 
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function QCXQ( P , Q : QUATERNION ) : QUATERNION ; 

begin 
with P do 


begin 

QCXQ.H 

:= H 

* 

Q.H + I 

* 

Q.I + J 


Q.J 


K 

* 

Q.K 

QCXQ. I 

:= H 


Q. I - I 

* 

Q.H - J 

* 

Q.K 

+ 

K 


Q.J 

QCXQ. J 

H 

* 

Q.J - J 

* 

Q.H - K 

* 

Q.I 


I 

* 

Q.K 

QCXQ.K 
end ; 

:= H 

* 

Q.K - K 

* 

Q.H - I 


Q.J 

+ 

J 

* 

Q.I 


end ; 


function QXQ( P , Q : QUATERNION ) : QUATERNION ; 

begin 
with P do 
begin 


QXQ.H 

:= H 

* 

Q.H 


I 

* 

Q.I 


J 

* 

Q.J - K 

* 

Q.K 

QXQ. I 

:= H 

* 

Q.I 

+ 

I 

* 

Q.H 

+ 

J 

* 

Q.K - K 

* 

Q.J 

QXQ. J 

:= H 

* 

Q.J 


J 

* 

Q.H 

+ 

K 

* 

Q.I - I 

* 

Q.K 

QXQ.K 

:= H 

* 

Q.K 

+ 

K 

* 

Q.H 

■f 

I 

* 

Q.J - J 

* 

Q.I 


end 

end ; 


function QXQC( P , Q : QUATERNION ) : QUATERNION ; 

begin 
with P do 


begin 

QXQC.H 

:= H 


Q.H + I 

* 

Q.I + J 

* 

Q.J 

+ 

K 

* 

Q.K 

QXQC.I 

:= I 


Q.H - H 

* 

Q.I - J 

* 

Q.K 

+ 

K 


Q.J 

QXQC. J 

:= J 

* 

Q.H - H 

* 

Q.J - K 

* 

Q.I 

+ 

I 

* 

Q.K 

QXQC.K 
end ; 

K 

* 

Q.H - H 

* 

Q.K - I 

* 

Q.J 


J 

* 

Q.I 


end ; 


function UNIQUAT( Q : QUATERNION ) : QUATERNION ; 
var 


F : longreal ; 


begin 

F := ONE / sqrt( sqr( Q.S ) + D0TP( Q.U, Q.U ) ) ; 
UNIQUAT.S := F * Q.S ; 

UNIQUAT.U := SXU< F, Q.U ) ; 
end ; 


vnnnnyiArn 
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function R0T( \) ■ UECTOR ; 

Q : 

QUATERNION ) = 

begin 

ROT := UXM( U, QMAT( Q 
end ; 

) ) 

* 

function IR0T( U : UECTOR; 

Q : 

QUATERNION ) : 

begin 

IROT := UXMT( U, QMAT( 
end : 

Q ) 

) ; 

procedure DIAGONALIZE ( S 


: SYMM3X3 ; 

TOLRATIO 

: longreal ; 

var D 


: DIAG3X3 ; 

var M 


: MAT3X3 ) ; 

begin 

DIAGONALIZE_SYMMATRIX ( 
end ; 

s, 

3, TOLRATIO, D, 


end ; { nodule UTILUEMQ 8f File * Ut i 1 venq . I * > 


<n •! .Tk rv rv i r* 
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<. Utility Software Unit for HP-9000 Series 200/300/500 Computers > 

module UTILSTAT ; { Subject : Statistics > 

{ Domain : Universal } 

< NASA/JSC/MPAD/TRUl Sam Ulilson > 

< Updated Sat Apr 12 22:20:13 1986 > 

i mpor t 

UTILHATH , 

UTILSPIF ; 

export 

type 

SIXUEC = {a six-vector (row matrix). > 

array [1..6] of longreai ; { Index = matrix column number. > 


SIXPOPDEF = {an array defining a population > 

array [1..21] of longreai ; { of six-vectors whose components > 


{ are zero-mean random numbers > 

< having correlated Gaussian > 

{ (normal) distributions. The elements of the array, in > 

< the order of storage, are: > 

< > 

{ sm, > 

< C[2,l], SE2], > 

{ C[5,l], C[3,2], 5E3], > 

{ C[4,ll, C[4,23, CC4,31, SC4], > 

{ C[5,l], CEB, 23, CEB, 33, CE5,43, SE53, > 

{ CE6,13, CE6,2], CEG,33, CC6,43, CEB, 5], SCGl, > 

< } 


{ where SEj] is the standard deviation of the jth compo- } 

< nent and CEi,j] = CEj,i3 is the coefficient of correla- > 
{ tion between components i and j. The magnitudes of the > 
{ CEi,J] must be less than ONE (unity), and the SEj] must > 

< be positive. This array is related to the population > 


{ covariance matrix COUAR through the equation > 

< > 

{ C0UAREi,j3 = SEi] * SEjl * CEi,j3 , > 

< > 

{ where C[J,j] = ONE by definition. The 6x6 correlation > 
{ matrix composed of the CCi,j3 (including the ONE values > 
{ on the main diagonal ) must be positive definite. > 

TRIANG6XG == {an array containing the nonzero } 

array El,, 21 3 of longreai ; { elements of a 6x6 triangular > 

{ matrix (see TRIANGMAT type dec- > 

{ laration in module UTILMATH). > 
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var 

RUNNUM : integer ; { Identification number for a simulation run > 

■C in a Monte Carlo series. If RUNNUM > 0, > 

i the assumed purpose of the run is to analyze > 
{ the effects of random dispersions and errors and/or to gen- > 

erate Monte Carlo statistics, and ail the pseudorandom num- > 

< ber functions defined in this module ( UNIFORM_RANDOM_SCALAR , } 

< GAUSSIAN_RANDOM__SCALAR, GAUS5I AN_RANDOM_SIXUECTOR ) will have > 
i nonzero values. If RUNNUM <= 0, the assumed purpose is to > 

< analyze or to familiarize the simulator pilot with the nomi- > 

< nal situation, and the pseudorandom functions will have zero > 

< values. > 

function UNIFORM_RANDOM_SCALAR( UNCERTAINTY : longreal ) : longreal ; 

{ If RUNNUM > 0, the value of this function is a pseudorandom > 

i number from a population which is uniformly distributed > 

< over the interval between -UNCERTAINTY and +UNCERTAINTY . > 

{ If RUNNUM <-0, the value of this function is ZERO. > 

function GAUSSI AN_RANDOM_SCALAR( SIGMA : longreal ) ^ longreal ; 

< If RUNNUM > 0, the value of this function is a pseudorandom > 

< number from a Gaussian (i.e., normally distributed) popula- > 

< tion having a mean of zero and a standard deviation (square > 

<. root of variance > equal to SIGMA. If RUNNUM <= 0, the > 

i value of this function is ZERO, > 
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function SIXTUCJiATRIX( SIXPOP = SIXPOPDEF ) = TRIANG6X6 ; 

{ The value of this function is an upper triangular 6x6 matrix > 


■( that can be used to transform a six-vector of uncorrelated } 

< zero-mean uni t-var iance Gaussian psedorandom numbers (U> > 

< into a pseudorandom six-vector of correlated components (U) } 

{ from the population defined by SIXPOP. The trans f orma t i on } 

{. is defined by the equation > 

< > 

<. {) = U ^ SIXTUC_MATRIX( SIXPOP ) , > 

< > 

{ where " * " represents the matrix multiplication operator and } 
{ the components of U are GAUSSI AN_RANDOh_SCALAR function > 

{ values , V i z : > 

< > 

< UCj] - GAUSSIAN_RANDOM_SCALAR( ONE ) } 

< > 

< for j=l,2,.,..6. > 

< If any one of three possible error conditions are found to } 

< exist in SIXPOP, the value of SIXTUC^NATRIX is undefined, > 

< and program execution will be aborted. The escapecode is > 

{ set equal to 9601 if one of the standard deviations (S[jl) > 

{ is found to he zero or negative. The escapecode is set to } 

< 9602 if an off-diagonal coefficient of correlation (CCi,jl) > 

< is found to be greater than or equal to ONE. If the corre- > 

■C lation matrix is found to be other than positive definite, > 

•C the escapecode is set equal to 9603. The reference to > 

< SIXTUC_NATR IX should be embedded in a " t ry /recover " con- > 

{ struct if it is desired to provide exception-handling code > 

•{ to recover from such eventualities. > 


function GAUSSI AN_RANDON_SI XUECTOR ( SIXTUC -• TRIANGBX6 ) = SIXOEC j 


< Given SIXTUC - SIXTUC_MATRIX( SIXPOP ), this routine will > 

< compute a pseudorandom Gaussian six-vector from the popula- > 

< tion defined by SIXPOP, and return it to the calling routine > 

{ as the value of GAUSSIAN_RANDON_SI XUECTOR . If RUNNUM <= 0, > 

< every component of GAUSSI AN_RANDOM__S IXUECTOR will have a > 

< value of ZERO. } 
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imp 1 ement 


function UNIF0RH_RAND0M_5CALAR ( UNCERTAINTY : longreal 


van 


R : longreal ; 

X : longreal ; 


begin 

R := max ini ; 

X := RANDOM^INTEGER / R j 
if RUNNUM > 0 

then UNIFORhLRANDON^SCALAR — ( TWO * X - ONE 
else UNIFORN_RANDON_SCALAR :== ( TWO * X - ONE 

end ; 


function GAUSSI AN_RANDOM„SCALAR( SIGMA : longreal ) : 
var 

G : longreal ; 

n : integer ; 

X : longreal ; 

begin 

X := ZERO ; 

for n := 1 to 12 do 

X := X + RANDOM_INTEGER ; 

6 := X / maxint - SIX ; 
if RUNNUM > 0 

then GAU5SIAN_RAND0M__5CALAR := G * SIGMA 
else GAUSSIAN RANDOM SCALAR G ♦ ZERO ; 


) : longreal ; 


) UNCERTAINTY 
) * ZERO ; 


longreal ; 


end ; 
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function SIXTUC^MATRIX ( SIXPOP : SIXPOPDEF ) : TRIANG6X6 i 

< Ref* Subroutine SAMPLE in Program OMDAP, coded by Elric McHenry > 

< (modified by D. M. Braley), NASA/ JSC/MPAID , ante April 1976 > 

const 

SIZE = G ; { number of vector components } 

var 

i : integer ; 

11 • integer ; 
ij ' integer ; 
j : integer ; 
jj : integer ; 

k • integer ; 

M : TRIANGBX6 ; 

X : longreal ; 

begin 

for i 1 to SIZE do 
begin 

ii TRIANG_INDEX( i, i ) ; 
if SIXPOPCii] <= ZERO then 

escape ( 9601 ) ; { illegal standard deviation > 

X := ONE ; 
if i > 1 then 

for k := 1 to 1-1 do 

X := X - sqr( M[TRIANG_INDEX(k, i )] ) ; 
if X > ZERO 

then M[ 1 i ] sqrt ( X ) 

else escape ( 9603 ) ; i correlation matrx is not pos definite > 
if i < SIZE then 

for j := i+1 to SIZE do 
begin 

ij := TRIANG_INDEX( i, j ) ; 
if abs( SIXPOPIij] ) < ONE 
then X := SIXPOPIij 1 

else escape ( 9G02 ) ; { illegal correlation coeff } 

i f i > 1 then 

for k := 1 to i-i do 

X := X - MITRIANG_INDEX(k, i )] 

MCTRIANG_.INDEX(k, j )] ; 

MCij] X / MCiil ; 
end ; 

for j := i to SIZE do 
begin 

ij := TRIAN6_INDEX( i, j ) ; 
jJ := TRIANG_INDEX( j, j ) ; 

SIXTUC^MATRIXI ij ] := MIij] * SlXPOPIjjl ; 
end ; 

end ; 

end i 
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function GAUSSIAN_RANDOM_SIXUECTOR( SIXTUC = TRIANGGXG ) = 5IXUEC ; 
var 

i : integer ; 
ij : integer ; 
j : integer ; 
k : integer ; 

U : SIXWEC ; 

U : SIXUEC ; 

begin 

for j := 1 to 6 do 

iJ[j] := GAUSSIAN_RAND0M_5CALAR( ONE ) ; 
for j 1 to 6 do 
begin 

UCj] := ZERO ; 
for i 1 to J do 

UCj] := u[j] + UCil * SIXTUC[TRIANG_INDEX( i, j )] ; 

end ; 

GAUSSIAN_RAND0M_5IXUECT0R =- 0 ; 
end ; 


end ; { nodule UTILSTAT & File ’Utilstat.I’ > 
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{ Utility Software Unit for HP”-9000 Hodel 216 with Pascal 3.0 Op Sys > 

$ Sysprog On $ 

$ search ’UTILUNIT’ $ 

$ Ref 60 $ 


prografv) TEST_UTILITY_^S0FTWARE_UI\1IT ( input, output ) ; 

{ NASA/JSC/MPAD/TRW San Wilson > 

{ Updated Sat Apr 12 22:35:51 1986 } 

inport 

UTIinATH , 

UTILSPIF , 

UTILUEMQ , 

UTIL5TAT 


const 


D 

- 

DIAG3X3 [ 

30.0L0, 

10.0L0, 

40.0L0 

] 

] 

K 


MAT3X3 [ 








UECTOR [ 

25.0L0, 

0.0L0, 

0.0L0 

.1 




SECTOR [ 

0.0L0, 

4-0. 0L0, 

0.0L0 

] 




UECTOR C 

0.0L0, 

0.0L0, 

55.0L0 

] 

3 

L 

= 

MAT3X3 [ 








UECTOR C 

ONE, 

TWO, 

-THREE 

3 




UECTOR C 

-TWO, 

FIUE, 

SIX 

] 

1 



UECTOR C 

FOUR, 

THREE, 

-FOUR 

3 

3 

M 


MAT3X3 [ 








UECTOR [ 

ONE, 

THREE, 

NINE 

] 

) 



UECTOR [ 

FOUR, 

FIUE, 

SIX 

] 

T 



UECTOR [ 

SEUEN, 

EIGHT, 

TWO 

] 

] 

PRY 

= 

EULPRY [ 

-14S.0L0, 

GB.0L0, 

-170. 0L0 

3 

f 

PYR 

= 

EULPYR [ 

80.0L0, 

-35.0L0, 

120. 0L0 

] 

t 

RPR 


EULRPR C 

10.0L0, 

-15.0L0, 

20.0L0 

3 

J 

YRY 

= 

EULYRY [ 

-5.0L0, 

S0.0L0, 

-55.0L0 

3 

J 


= 

UECTOR [ 

TWO, 

-SIX, 

THREE 

3 

r 

U 


UECTOR [ 

FOUR, 

FIUE, 

-ONE 

3 

; 


type 


CLASSREC = 
record 

UUB •• longreal ; 
CDF : longreal ; 
end ; { record > 


< record of data pertaining to one class of > 
{ values for a continuous random variable > 
{ value of the upper bound for this class > 

{ cumulative distribution function for this class > 


CLASSARR - 


< description of the distribution > 
\ of d cjuniiriuous random variable > 


DESCRIPSTR - string [ 22 1 ; { descriptive text for an output quantity > 


V /i /I /I 


1 
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const 


NULLDE5CRIP 

TENSPACES 


< 1 234567890 1 23456789012 > 
» 1 

» 1 


var 


E 

H 

N 

OUTLINE 

P 

Q 

R 

S 

SAUTICK 

TIME 

X 


DIAG3X3 

integer 

MnT3X3 

LINESTR 

QUATERNION 

QUATERNION 

QUATERNION 

5YMM3X3 

integer 

longreai 

UECTOR 


procedure PRINT^FIXED^SCALAR ( DESCRIP 
procedure PRINT__FI XED JI AG3X3( DESCRIP 
procedure PRINT_FIXED_EULARR ( DESCRIP 
procedure PRINT_FIXED__UECTOR ( DESCRIP 
procedure PR INT_FI XED_MAT3X3 ( DESCRIP 
procedure PRINT_FIXED_SIXUEC ( DESCRIP 
procedure PRINT^FIXED^SIXPOP ( DESCRIP 

procedure PRINT_FLOAT_SCALAR ( DESCRIP 
procedure PRINT^FLOAT^EULARR ( DESCRIP 
procedure PRINT_FLOAT_UECTOR ( DESCRIP 
procedure PRINT_FL0AT_MAT3X3 < DESCRIP 
procedure PRINT_FLOAT_SIXPOP ( DESCRIP 


DESCRIPSTR 

s 

longreai 

) 

DESCRIPSTR 

D 

DIAG3X3 

) 

DESCRIPSTR 

E 

EULARR 

) 

DESCRIPSTR 

U 

UECTOR 

) 

DESCRIPSTR 

M 

MAT3X3 

) 

DESCRIPSTR 

U 

SIXUEC 

) 

DESCRIPSTR 

5 

SIXPOPDEF) 

DESCRIPSTR 

S 

1 ongreal 

) 

DESCRIPSTR 

E 

EULARR 

) 

DESCRIPSTR 

U 

UECTOR 

) 

DESCRIPSTR 

M 

MAT3X3 

) 

DESCRIPSTR 

5 

SIXPOPDEF ) 


procedure TE5TJJTILUEMQ_UECT0R_FUNCTI0NS 

procedure TEST^UT ILUEMQ_MATR IX^FUNCTIONS 

procedure TEST^UT ILUEMQ„IMATQ_FUNCT ION 

procedure TEST_UTILUEMQ_EULER_QUAT_FUNCTIONS 

procedure TEST_UTILUEMQ_QUAT.^ROT,FUNCTIONS 

procedure TEST_UTILUEMQ_UNIQUAT_FUNCTION 

procedure TEST_UTILUEMQ_MATRIX_DI AGONAL I ZATION 

procedure TEST^UT ILSTAT_UNIFORM_RANDOM_SCALAR_FLINCT I ON 

procedure TEST_UTILSTAT_GAUSS I AN_RANDOM_SCALAR„FUNCT ION 

procedure TEST_UTILSTAT_5IXTUC_MATRIX_FUNCTI0N 

procedure TEST_UTILSTAT_GAUSSI AN_RANDOM_SIXUECTOR__FUNCTION 



$ 

list 

off 

$ 

> 

$ 

include 

’ Prtprocs . I . 

’ $ 

{ 

$ 

list 

on 

$ 

> 

< 

$ 

list 

off 

$ 

> 

$ 

include 

’ Test nath . I , 

’ $ 

< 

$ 

1 i. s t 

on 

$ 

> 

{ 

$ 

list 

off 

$ 

} 

$ 

include 

* Test spif . I , 

» $ 

{ 

$ 

list 

on 

$ 

> 

< 

$ 

list 

off 

$ 

> 

$ 

include 

’ Test venq . I , 

’ $ 

\ 

$ 

list 

on 

$ 

} 


$ 

list 

off 

$ 

} 

$ 

i nc lude 

’Teslstat . I . 

’ $ 

{ 

$ 

list 

on 

$ 

> 


; f orward ; 
; f oruiard ; 
; f oruiard ; 
; f oruiard ; 
; f oruiard : 
; f oruiard i 
; f orward ; 

; f oruiar d ; 
; f orward j 
; f orward ; 
; f orward ; 
; f orwar d ; 

; f orward ; 
; f orwar d ; 
; f orward ; 
; f orwar d ; 
; f orward ; 
j f orwar d ; 
; f orward ; 
; f orward ; 
; f orward ; 
; f orwar d ; 
; f orward ; 
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begin { program TEST_UTILITY_SOFTUAREJJNIT } 

INITIALIZE_IO : 

SAUTICK := CLOCKTICK ; 

SHOWLN ( ’Test results will be saved in text file ’ ’ UTILTEST . R ' ’ ’ > ; 

rewrite ( LP, ’UTILTEST. R’ > ; 

uriteln ( LP, ’Utility Software Unit Tes t ’,’ Run ’= 26 , DATESTRING = 27 ) ; 
if USER_DECIDES_TO( ’Test UTILMATH module’ ) then TEST_UTILMATH_MODULE : 

if USER_DECIDES_TO( ’Test UTILSPIF module’ ) then TEST_UTILSPIF_MODULE ; 

if USER_DECIDES_TO( ’Test UTILUEMQ module’ ) then TEST_UTILUEMQ_MODULE ; 

if USER_DECIDES_TO( ’Test UTILSTAT module’ ) then TEST_UTILSTAT_MODULE ; 

SHOWLN ( ’Tests completed’ ) ; 

SHOWLN ( ” ) : 

OUTLINE ; 

strwrite ( OUTL INE , 1 , H , ’ E 1 apsed time = ’, 

( (CLOCKTICK-SAUTICK )/TICKSPERSEC ):S:2, ’ seconds’ ) : 

SHOWLN ( OUTLINE ) ; 

SHOWLN ( ” ) ; 

LOITER ( 500 ) : 

for H := 1 to 5 do writeln ( LP ) : 

writeln ( LP, ’Tests completed’ ) : 

writeln ( LP ) ; 

writeln < LP, OUTLINE ) ; 

writeln ( LP ) : 

close ( LP, ’SAUE’ ) ; 

CLEAN_UP_IO ; 

end . < program TEST_UTILITY„SOFTWAREJJNIT & File ’UTILTEST.TEXT’ > 


vcD'srcrDr 
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<. Utility Software Unit for HP-9000 Series 500 with HP-UX 5.0 Op Sys > 

$ 5 1 andard_level ’hp_roodcal’ $ 

$ search ’utilunit.o’ $ 


program TEST_UTILITY.^SOFTUIAREJJNIT ( input, output 

{ NASA/JSC/MPAD/TRW Sam Wilson > 

<. Updated Sat Apr 12 22:52:11 198G > 


) ; 


i mpor t 


UTILMATH , 
UTILSPIF , 
UTILUEMQ , 
UTILSTAT ; 

const 


D 


DIAG3X3 [ 

30.0L0, 

10.0L0, 

40.0L0 

] 


K 


MAT3X3 [ 








SECTOR C 

25.0L0, 

0.0L0, 

0.0L0 

] 

T 



UECTOR [ 

0.0L0, 

40.0L0, 

0.0L0 

.1 

J 



UECTOR [ 

0.0L0, 

0.0L0, 

55.0L0 

] 

] 

L 

= 

MAT3X3 [ 








SECTOR [ 

ONE, 

TWO , 

-THREE 

] 

? 



UECTOR L 

-TWO, 

FR/'E, 

SIX 

] 

) 



UECTOR [ 

FOUR, 

THREE, 

-FOUR 

] 

] 

M 


MAT3X3 C 








UECTOR [ 

ONE, 

THREE, 

NINE 

] 

J 



UECTOR [ 

FOUR, 

FIl/E, 

SIX 

] 

1 



UECTOR [ 

SEUEN, 

EIGHT, 

TWO 

] 

] 

PRY 


EULPRY [ 

-14B.0L0, 

65.0L0, 

-170.0L0 

.1 

• 

PYR 


EULPYR [ 

80.0L0, 

-35.0L0, 

120. 0L0 

.1 

; 

RPR 

= 

EULRPR [ 

10.0L0, 

-15.0L0, 

20.0L0 

] 

; 

YRY 


EULYRY [ 

-5.0L0, 

80.0L0, 

-55.0L0 

] 

; 

U 

= 

UECTOR [ 

TWO, 

-SIX, 

THREE 

] 

r 

W 

= 

UECTOR C 

FOUR, 

FIUE, 

-ONE 

] 

> 


type 

CLASSREC - 
record 

UUB : longreal ; 

CDF : longreal ; 
end ; { record > 

CLASSARR == { description of the distribution > 

array [ 0..10 ] of CLASSREC i { of a continuous random variable } 

DESCRIP5TR = string C 22 1 ; { descriptive text for an output quantity > 


i record of data pertaining to one class of > 
{ values for a continuous random variable > 
< value of the upper bound for this class > 

{ cumulative distribution function for this class } 


voc9fT7nr£r 
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const 


NULLDESCRIP 

TENSPACES 


{12345678901 23456789012} 


var 


E 

H 

N 

OUTLINE 

P 

Q 

R 

S 

SAUTICK 

TIME 

X 


DIAG3X3 

int eger 

MAT3X3 

LINESTR 

QUATERNION 

QUATERNION 

QUATERNION 

SYMM3X3 

integer 

longreal 

UECTOR 


procedure PRINT_FIXED_SCALAR ( DESCRIP 
procedure PRINT^FIXEDJI AG3X3( DESCRIP 
procedure PRINT_FIXED_EULARR ( DESCRIP 
procedure PRINT_FIXED„UECTOR ( DESCRIP 
procedure PRINT_FIXED_^MAT3X3 ( DESCRIP 
procedure PRINT„FI XED^SI XUEC ( DESCRIP 
procedure PRINT_FIXED__SIXPOP ( DESCRIP 


DESCRIPSTR 

s 

DESCRIPSTR ; 

D 

DESCRIPSTR : 

E 

DESCRIPSTR i 

U 

DESCRIPSTR i 

M 

DESCRIPSTR ] 

U 

DESCRIPSTR ; 

S 


longreal ) 
DIAG3X3 ) 
EULARR ) 
UECTOR ) 
MAT3X3 ) 
SIXUEC ) 
SIXPOPDEF) 


procedure 

PRINT^ 

.FLOAT. 

.SCALAR 

( 

DESCRIP 

DESCRIPSTR 

S 

1 ongreal 

) 

procedure 

PRINT, 

.FLOAT. 

.EULARR 

( 

DESCRIP 

DESCRIPSTR 

E 

EULARR 

) 

procedure 

PRINT. 

.FLOAT. 

.UECTOR 

( 

DESCRIP 

DESCRIPSTR 

U 

UECTOR 

) 

procedure 

PRINT. 

.FLOAT. 

.MAT3X3 

( 

DESCRIP 

DESCRIPSTR 

M 

MAT3X3 

) 

procedure 

PRINT. 

.FLOAT. 

.5IXP0P 

( 

DESCRIP 

DESCRIPSTR 

S 

SIXPOPDEF ) 


procedure TEST^UT ILUEMQ_UECTOR_FUNCTIONS 

procedure TEST_UTILUEMQ_MATR IX^FUNCTIONS 

procedure TESTJJTILUEMQ_IMATQ_FUNCTION 

procedure TEST_UTILUEMQ_EULER_QUAT_FUNCTIONS 

procedure TEST_UTILUEMQ_QUAT_ROT_FUNCTIONS 

procedure TEST_UTILUEMQ_UN IQUAT^FUNCTION 

procedure TEST_UTILUEMQ_MATRIX_DIA60NALIZATI0N 

procedure TE5T_UTILSTAT_LiNI FORM_RANGOM_SCALAR_FUNCT ION 

procedure TEST_UTILSTAT_GAUSS I AN_RANDOM_SCALAR_FUNCT ION 

procedure TEST_UTILSTAT_5IXTUC_MATRIX_FUNCTI ON 

procedure TE5T_UTILSTAT_GAUSS I AN_RANDOM_SIXUECTOR_FUNCTION 


{ 

$ 

list 

off 

$ 

} 

$ 

include 

’ Pr tprocs . 

I’ 

$ 

{ 

$ 

list 

on 

$ 

} 

{ 

$ 

list 

off 

$ 

} 

$ 

include 

’ Testrjath . 

I ’ 

$ 

{ 

$ 

list 

on 

$ 

> 

{ 

$ 

list 

off 

$ 

} 

$ 

include 

’ Test spi f . 

I ’ 

$ 

{ 

$ 

list 

on 

$ 

> 

{ 

$ 

list 

off 

$ 

} 

$ 

include 

’ Test veroq . 

I’ 

$ 

{ 

$ 

list 

on 

$ 

> 

{ 

$ 

list 

off 

$ 

} 

$ 

include 

’Teststat . 

I ’ 

$ 

{ 

$ 

list 

on 

$ 

> 


; forward ; 
; f orwar d ; 
; f orward ; 
; f orward ; 
; f orward ; 
; f orward ; 
; f orward ; 

; f orwar d ; 
; f orward ; 
; f orwar d ; 
; f orward ; 
; f orward ; 

; f orward ; 
; f orward ; 
; forward ; 
; forward ; 
; f orward ; 
; f orward ; 
; f orward ; 
; f orward ; 
; f orward ; 
; f orward ; 
; f orward ; 
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begin { program TEST^UTILI TY^SOFTWAREJJNIT > 

INITIALIZE^IO ; 

SAUTICK := CLOCKTICK ; 

SHOWLN ( ’Test results will be saved in text file ’ ’ u t i 1 1 es t . R ’ ’ ’ ) 


rewrite ( LP, ’utiitest.R’ ) ; 

writeln ( LP , ’Utility Software Unit Tes t ’ , ’ Run ’ = 2B , DATESTR TNG : 27 ) ; 
if USER_DECIDES__TO( ’Test UTILMATH module’ ) then TE5T__UTILMATH_M0DULE 

if USER_DECIDES_TO( ’Test UTILSPIF module’ ) then TEST_UTILSPIF_MODULE 

if U5ER_DECIDES_T0( ’Test UTILUEMQ module’ ) then TEST_UTILUEMQ_NODULE 

if USER_DECIDES_TO( ’Test UTILSTAT module’ ) then TEST_UTILSTAT_MODULE 

SHOWLN ( ’Tests completed’ ) ; 

SHOWLN ( ” ) ; 

OUTLINE ; 


strwrite < OUTL INE , 1 , H E lapsed time = *, 

( (CLOCKTICK-SAUTICK )/TICKSPERSEC ) : 5 : 2 , ’ seconds’ 

SHOWLN ( OUTLINE ) ; 

SHOWLN ( ” ) ; 

LOITER ( 500 ) ; 


for H := 1 to 5 do writeln ( LP ) ; 

writeln ( LP, ’Tests completed’ ) ; 

writeln ( LP ) ; 

writeln ( LP, OUTLINE ) ; 

writeln ( LP ) j 

close ( LP, ’SAUE’ ) ; 

CLEAN_UP_IO ; 

end . { program TEST„UTILITY_SOFTWARE_UNIT & File ’utiltest.p’ } 



) ; 


¥E85C23DC 
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$ page $ { begin File ’Prtprocs.I’ > 

{. Utility Software Unit for HP-9000 Series 200/300/500 Computers > 

{ NASA/JSC/MPAD/TRW Sam Wilson > 

{ Updated Thu Apr 10 23:33:60 1986 > 


procedure PRINT^FI XED^SCALAR ( DESCRIP : DESCRIPSTR 
begin 

writein ( LP , DESCRIP : 22 , S : 1 9 : 13 ) ; 
end ; 


longreal ) 


procedure PR INT_F IXED_D I AG3X3 ( DESCRIP : DESCRIPSTR ; D : DIAG3X3 ) ; 
var 

j : integer ; 

begin 

write ( LP, DESCRIP:22 ) ; 

for j := 1 to 3 do write ( LP, D[j]:19:13 ) ; 

writein ( LP ) ; 

end i 


procedure PRINT^FIXED^EULARR ( DESCRIP : DESCRIPSTR ; E : EULARR ) ; 
var 

j : integer ; 

begin 

write ( LP, DESCRIP:22 ) ; 

for j := 1 to 3 do write ( LP , ECj]:19:13 ) ; 

writein ( LP ) ; 

end ; 


procedure PRINT^FI XED^UECTOR ( DESCRIP -* DESCRIPSTR ; U : UECTOR ) ; 
var 

j : integer ; 

begin 

write ( LP, DESCRIP:22 ) ; 

for j := 1 to 3 do write < LP, U[j]:19:13 ) ; 

writein ( LP ) ; 

end ; 
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procedure PRINT_FIXED_MAT3X3 ( DESCRIP : DESCRIPSTR ; N : HAT3X3 ) ; 


van 


i : integer ; 


begin 

PRINT_FIXED_UECTOR ( DESCRIP, M[l] ) ; 

for i 2 to 3 do PRINT_FIXED_UECTOR ( NULLDESCRIP, MI i ] ) ; 
end : 


procedure PRINT^F I XED^S I XUEC < DESCRIP : DESCRIPSTR ; U : SIXUEC ) ; 


V a r 

j : integer ; 

K • integer ; 

L : LINESTR ; 

begin 
K := 1 ; 

L ; 

strwrite ( L , K , K , DESCR IP : 22 ) ; 

for j 1 to 6 do strurite ( L ,K , K , UC j ] : 9 • 4 ) ; 
writeln ( LP, 1=76 ); 
end ; 


procedure PRINT_FIXED_SIXPOP < DESCRIP : DESCRIPSTR ; S : SIXPOPDEF ) ; 
var 

i : integer ; 
j • integer ; 

begin 

for i i to 6 do 
begin 
i f i = 1 

then write ( LP, DESCRIP:22 ) 
else write ( LP, ” :22 ) ; 
for j := 1 to i do 

write ( LP, SC TR I ANG^INDEX ( i , j ) ] : 9 : 3 ) ; 
writeln ( LP ) ; 
end ; 

end ; 


v7PR7nAn7 


1 -I ^ 
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procedure PRINT_FLOAT_SCALAR ( DESCRIP : DE5CRIPSTR ; S : longreal ) ; 
begin 

writein ( LP , DESCR IP : 22 , TENSPACE5 , S : 9 ) ; 
end ; 


procedure PRINT_FLOAT_EULARR ( DESCRIP : DESCRIPSTR ; E : EULARR ) ; 
var 


j : integer ; 


begin 

write < LP, DESCRIP:22 ) ; 

for j := 1 to 3 do write ( LP , TENSPACES , E[ j ] : 9 ) ; 
writeln ( LP ) ; 
end ; 


procedure PRINT_FLOAT_UECTOR ( DESCRIP : DESCRIPSTR ; U : UECTOR ) ; 
var 


j : integer ; 


begin 

write ( LP, DESCRIP:22 ) ; 

for J 1 to 3 do write. ( LP, TENSPACES , U[ j ] : 9 ) 
writeln ( LP ) ; 
end ; 


procedure PRINT_FL0ATJ'1AT3X3 ( DESCRIP : DESCRIPSTR ; M : MAT3X3 ) 


var 


i : integer j 


begin 

PRINT_FLOAT__UECTOR ( DESCRIP, MCI! ) ; 

for i 2 to 3 do PR INT_FLOAT_UECTOR ( NULLDESCRIP, Mlil ) ; 
end ; 
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procedure PRINT_FLOAT_SIXPOP ( DESCRIP : DESCRIPSTR ; 
var 

i : integer ; 

j : integer ; 

begin 

for i := 1 to 6 do 
begin 
if i - 1 

then write ( LP , DESCRIP:22 ) 
else write ( LP, ’’:22 ) ; 
for j := 1 to i do 

write ( LP, ’ ’ ,S[TRIANG_INDEX(i,j )]:8 
writeln ( LP ) ; 
end ; 

end ; 

{ end File ’Prtprocs.I’ > 


: SIXPOPDEF ) ; 
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$ page $ { begin File ’Teatmath.T’ > 


{ Utility Software Unit for HP”9000 Series 200/300/500 Computers } 

procedure TEST^UTILMATtLMODULE ; 

{ NASA/J5C/MPAD/TRW Sam Wilson > 

< Updated Thu Apr 10 23:37:17 1986 > 

const 

FLD = 45 ; 


var 


i : integer ; 


begin < procedure TEST^UT TLMATH^MODULE > 
for i := 1 to 2 do uriteln ( LP ) ; 
writeln ( LP , ’TEST UTILMATH MODULE’ :49 ) ; 


for i := 1 to 5 do writeln 


writeln 

( 

LP, 

’INK 

-2.3 ) 

writeln 

( 

LP, 

’INK 

-2.0 ) 

writeln 

( 

LP, 

’ INK 

-0.3 ) 

writeln 

( 

LP, 

’INK 

0.0 ) 

writeln 

( 

LP, 

’INK 

1.3 ) 

writeln 

\ 

LP 

) i 


w r' i t e 1 n 

( 

LP, 

’FRAC( 

-2.3 

writeln 

( 

LP, 

’FRAC( 

-2.0 

writeln 

( 

LP, 

’FRAC( 

-0 . 3 

writeln 

( 

LP, 

’FRAC( 

0.0 

writeln 

( 

LP, 

’FRAC( 

1.3 

writeln 

< 

LP 

) ; 



( LP ) ; 


= ’:FLD,INK 

-2.3 

) 

i- 

) 

= ’: FLD, INK 

-2.0 

) 

2 

) 

= ’:FLD,INK 

-0.3 

) 

2 

> 

= ’: FLD, INK 

0.0 

) 

n 

) 

= ’:FLD,INK 

1.3 

): 

2 

) 


) - 

’ :FLD,FRAC( 

-2 . 3 

) 

5 

7 

) ; 

) = 

:FLD,FRAC( 

-2.0 

) 

5 

2 

) ; 

) - 

’ :FLD,FRAC( 

-0.3 

) 

5 

9 

) ; 

) = 

’ :FLD,FRAC( 

0.0 

) 

5 

9 

iL. 

) j 

) = 

’ :FLD,FRAC( 

1.3 

) 

5 

T 

4 

) ; 


writeln 

( 

LP. 

’RM0D( 

-2.8, 

-0.5 

) = 

’ :FLD,RM0D( 

-2.8, 

-0.5 

wr i t el n 

( 

LP, 

’RM0D( 

-2.8, 

0.0 

) = 

’ :FLD,RM0D( 

-2.8, 

0.0 

writeln 

( 

LP, 

’RM0D( 

-2.8, 

0.5 

) - 

’ :FLD,RM0D( 

-2.8, 

0.5 

writeln 

( 

LP 

) ; 







writeln 

( 

LP, 

’RM0D( 

2.8, 

-0.5 

) = 

’ :FLD,RM0D( 

2.8, 

-0.5 

writeln 

( 

LP, 

’RM0D( 

2.8, 

0.0 

) = 

’ :FLD,RM0D( 

2.8, 

0.0 

writeln 

( 

LP, 

’RM0D( 

2.8, 

0.5 

) = 

’ :FLD,RM0D< 

2.8, 

0.5 

writeln 

< 

LP 

) ; 








writeln ( LP, ’RSIGN( -1.9 
writeln < LP, ’RSIGN( 0.0 
writeln ( LP , ’RSIGN( 1.9 
writeln < LP ) j 

writeln ( LP, ’ISIGN( 
writeln ( LP, ’ISIGN( 
writeln ( LP , ’ISIGN( 
writeln ( LP ) ; 


FLD,RSIGN( 

-1.9 

):2 

FLD,RSieN< 

0.0 

):2 

FLD,RSIGN< 

1.9 

):2 


FLD, I5IGN( 

-5 

) 

2 

) ; 

FLD,ISIGN( 

0 

) 

2 

) ; 

FLD, ISIGN( 

5 

) 

9 

) ; 


-5 ) = 
0 ) = 
5 ) = 


r u r-o r o r o r o 
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writeln 

( 

LP, 

-3, -4 

) = ’ 

':FLD,IMAX( -3, 

-4 ):2 

) ; 


writeln 

( 

LP, ’IHAX( 

3, 4 

) = ’ 

’:FLD,IMAX( 3, 

4 ):2 

) ; 


writeln 

( 

LP ) ; 







w r" i t e 1 n 

( 

LP, ’IMIN( 

-3, -4 

) = ’ 

’:FLD,IMIN( -3, 

-4 ):2 

) ; 


wr i t eln 

( 

LP, ’IMIN( 

3, 4 

) = ’ 

:FLD,IMIN< 3, 

4 ):2 

) ; 


writeln 

( 

LP ) ; 







writeln 

( 

LP, ’RMAX( 

-2.9, - 

■5.9 : 

) = ’ :FLD,RMAX( 

-2.9, 

-3.9 

):5 

wr i t el n 

( 

LP, ’RMAX( 

2.9, 

3.9 : 

1 = ’ :FLD,RMAX( 

2.9, 

3.9 

):5 

writeln 

( 

LP ) ; 







w r i t e 1. n 

( 

LP, ’RMIN< 

1 

CD 

1 

■3.9 ; 

» = ’ :FLD,RMIN( 

-2.9, ■ 

-3.9 

):5 

writeln 

( 

LP, ’RMIN( 

2.9, 

3.9 : 

• = ’ :FLD,RMIN( 

2.9, 

3.9 

):5 


START_NEI*I_PAGE : 

for i := 1 to 9 do writeln ( LP ) : 

uiriteln ( LP, ’ ANGDEG( ONE ) = ’ = FLD , ANGDEG< ONE ) = 18 = 14 ) ; 
uiriteln ( LP, ’ ANGRAD< ANGDEG( ONE ) )-0NE = ’:FLD, 
(ANGRAD(ANGDE6(0NE))-0NE):7 ) ; 
uiri teln ( LP ) ; 


{12345678901234567890123456789012345} 
writeln ( LP, ’ ANGDEG( ANGl ( -THREE*TWOPI-HAFPI ) ) = ’:FLD, 
ANGDEG( ANG1(-THREE*TW0PI-HAFPI > ): 17: 12 ) ; 
uiriteln ( LP, ’ ANGDEG( ANG2( THREE*TWOPI-HAFPI ) ) = ’:FLD, 
ANGDEG(ANG2( THREE*TWOPI-HAFPI ) ) : 17= 12 ) : 
uiriteln ( LP ) : 


uiriteln ( LP , ’ ANGDEG( ATANl ( -SIX , SIX ) ) = ’:FLD, 
ANGDEG( ATAN1(-SIX,SIX ) ): 17: 12 ) ; 
uiriteln ( LP , ’ ANGDEG( ATAN2 ( -S IX , SIX ) ) = ’:FLD, 
ANGDEG( ATAN2(-SIX,SIX ) ): 17: 12 ) ; 


writeln 

( 

LP 

) : 




writeln 

( 

LP, 

’HMS( -36385. 874L0 ) 

= ’:FLD,HMS( 

-36385. 874L0 

):12:6 ) 

writeln 

( 

LP, 

’HMS( 36385. 874L0 ) 

= ’:FLD,HMS( 

36385. 874L0 

>: 12:6 ) 

writeln 

( 

LP 

) ; 




writeln 

( 

LP, 

’SECS( -1006.25874L0 

) = ’ :FLD, 






SECS( -1006.25874L0 

):13:6 ) ; 



writeln 

( 

LP, 

’SECS( 1006.25874L0 

) = ’ :FLD, 






SECS( 1006.25874L0 

):13:6 ) : 



writeln 

( 

LP 

) ; 




writeln 

( 

LP, 

’ JULIAN_DAYNUM( 1980, 

4, 2 ) = ’ : 

FLO, 



JULIAN_DAYNUM( 1980, 4, 2 ):8 ) : 


START_NEU_PAGE ; 

end ; { procedure TEST_UTILMATH_MODULE > 

{ end File ’Testnath.I’ > 
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$ page $ { begin File ’Testspif.I’ > 

{ Utility Software Unit for HP--9000 Series 200/300/500 Computers > 

procedure TEST^UTILSPIF^MODULE ; 

{ NA5A/JSC/MPAD/TRW Sam Wilson > 

■C Updated Thu Apr 10 23:30:45 1986 > 

const 


{ 1 2345678901 234567890 1 2345678901 254567890 12345> 
PI = ’Your name’ ; 

P2 = ’ Age ( year s ) ’ 

P3 = ’ Home t own ’ 

P4 -■ ’Direction from here <N , NE , E , SE , S , SW , W , NW> ’ 

P5 = ’Distance (miles)’ 


var 


W1 

WORDSTR ; 

12 

integer ; 

W3 

WORDSTR ; 

W4 

WORDSTR ; 

F5 

longreal ; 

I 

: integer 

n 

: integer 

OUTLINE : LINESTR 


WORK 


CHINPUTREC 
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begin < procedure TEST_UTILSP IF_M0DULE > 
for n := 1 to 2 do writeln ( LP ) i 
uiriteln ( LP , ’ TE5T_UTILSPIF_hODULE ’ : 49 ) ; 
for n := 1 to 5 do uriteln ( LP ) ; 

SOUND_ALERT ; 

SHOW ( ’Waiting 2 seconds; if you press a key it will be echoed ’ ) ; 

LOITER ( 2000 ) ; 

WORK CHAR_INPUT( NOCHWAIT, CHECHO ) ; 

SHOWLN ( ” ) ; 

SOUND^ALERT ; 

SHOW ( ’Waiting indefinitely; press any key to continue " ’ ) ; 

OUTLINE ; 

strwrite ( OUTLINE , 1 , I , CHAR_INPUT( CHWAIT, NOCHECHO ) ; 

SHOWLN ( OUTLINE ) ; 


W1 

:= RJWORD_INPUT( 

PI, 

’ Rump lest iltskin’, 15, 

15 

) 

12 

:= INTEGER_INPUT( 

P2. 

maxint , 15 


) 

W3 

:= RJWORD_INPUT( 

P3, 

’Brno, Czechoslovakia’, 15, 

15 

) 

W4 

:= RJWORD_INPUT( 

P4, 

’NE’, 15, 

15 

) 

F5 

:= FIXED_.INPUT< 

P5, 

8299.11111877 , 15, 

5 

) 


wr 1 teln 

( 

LP, 

( ’ ’ 

' ’+W1 + ’ " ’ 

): 

17 

) 

uriteln 

( 

LP, 

12: 

:16 ) ; 




uriteln 

( 

LP, 

( ’ ' 

' ’+W3+’ " ’ 

): 

17 

) 

writeln 

( 

LP, 

( ’ ' 

' ’+W4+’ " ’ 

): 

17 

) 

wr i t el n 

( 

LP, 

F5: 

16:8 ) ; 





for n 1 to 3 do writeln ( LP ) ; 

uriteln ( LP , ’ START_RANDON_NUMBER_5EQUENCE ( 1 )’ ) 

START_RANDON_NUNBER_SEQUENCE ( 1 ) ; 

uriteln ( LP ) ; 

uriteln ( LP , ’ Pseudorandom integers:’ ) ; 

uriteln < LP ) ; 
for n := 1 to 10 do 

uriteln ( LP , RANDOM^INTEGER: 10 ) ; 


for n 1 to 3 do uriteln ( LP ) ; 

uriteln ( LP, ’ START_RANDOM_NUMBER_SEQUENCE ( 2147483646 )’ ) ; 
START^RANDON^NUNBER^SEQUENCE ( 2147483646 ) ; 
uriteln ( LP ) ; 

uriteln ( LP , ’Pseudorandom integers:’ ) ; 
uriteln ( LP ) ; 
for n := 1 to 10 do 

writeln ( LP , RANDOM^INTEGER : 1 0 ) ; 

START_NEW_PAGE ; 

end ; < procedure TESTJJTILSP IFJiODULE > 

{ end File ’Testspif.I’ } 
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$ page $ < begin File ’Testvemq.I’ } 

{ Utility Software Unit for HP-0000 Series 200/300/500 Computers } 

procedure TE5T_UTILUEMQ_hODULE ; 

{ NASA/JSC/MPAD/TRW Sam Wilson > 

< Updated Thu Apr 10 23:47:14 1986 > 


var 


i : integer ; 


begin 

for 1 1 to 2 do writeln ( LP ) ; 

writeln ( LP , ’ TEST^UT ILUEMQ_MODULE ’ : 49 ) ; 
for i := 1 to 5 do uiriteln ( LP ) ; 

TEST_UTILUEMQ_UECTOR_FUNCTIONS ; 
TEST_UTILUEMQ_MATRIX_^FUNCTIONS ; 
TEST_UTILUEHQ_IMATQ_FUNCTION ; 
TEST_^UTILUEMQ.^EULER_QUAT_FUNCTIONS ; 
TEST_UTILUEMQ_QUAT_ROT_FUNCTION5 ; 
TEST^UTILUEHQ^UNTQUAT^FUNCTION ; 
TEST_^UTILUEMQJ1ATRIX_DIAGQNALIZhTI0N ; 


end 
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$ page $ 

procedure TEST_UTILUEMQ_^ECT0R^FUNCTI0N3 ; 
var 

i : integer ; 
j : integer ; 

begin 

PRINT^FIXED^UECTOR 
writeln ( LP ) ; 

PRINT_^FIXED_UECTOR 
writeln ( LP ) ; 

PRINT^FIXED^SCALAR 
writeln ( LP ) ; 

PRINT_FIXED_SCALAR 
writeln ( LP ) ; 

PRINT^FIXED^UECTOR 
writeln ( LP ) ; 

PRINT^FIXEDJ^ECTOR 
writeln ( LP ) ; 

PRINT^FIXED^UECTOR 
writeln ( LP ) ; 

PRINT__FIXED_WECTOR 
for 1 *• = 1 to 5 do 

< 1234567890123456789012} 
write ( LP, ’ D =’ ) ; 

for j := 1 to 3 do write ( LP, D[j]:19:13 ) ; 
for i := 1 to 2 do writeln ( LP ) ; 
PRINT_FIXED_UECTOR ( ’UXD(U,D) =’,UXD(U,D) ) ; 
for i := 1 to 5 do writeln ( LP ) ; 

PRINT_FIXED_MAT3X3 ( ’M ) ; 

writeln ( LP ) ; 

PRINT„FIXED_UECTOR ( ’UXM(U,M) -’,UXM(U,I4) ) ; 
writeln ( LP ) ; 

PRINT__FIXED_UECTOR ( ’ UXMT(U , H ) = ’ , UXMT( U , M ) ) ; 

START^NEUI^PAGE ; 
end ; 


( ,U ) ; 

( ’W ,W ) ; 

( ’D0TP<U,W) =’ ,DOTP(U,W) ) : 

( ’UMA6(U) =’,UMAG<U) ) ; 

( ’SXU(TW0,U) =’ ,5XU(TW0,U) ) ; 

( ’CRSP(U,W) =’ ,CRSP(U,W) ) ; 

( ’UDIFOJ,W) =’ ,UDIF(U,W) ) ; 

( ’L>SUM(U,W) =’ ,USUM(iJ,W) ) ; 

writeln ( LP ) ; 


\/ •-?r-ir-An'^OA 
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$ page $ 

procedure TEST^^UTILUEMQ^MATR I X^FUNCTIONS ; 
var 

i : integer ; 

begin 

for i := 1 to 9 do writeln ( LP ) ; 

PRIIMT_FIXED_MAT3X3 ( ’L =’,L ) ; 
writeln ( LP ) ; 

PRINT_FIXED_MAT3X3 ( ’ hO IF( L , II ) - \ MDIF( L . M ) ) ; 
write-in ( LP ) ; 

PRINT_FIXED_MAT5X3 ( ’ MSUM( L , M ) = ’ , M3UM( L , M ) ) ; 
writeln ( LP ) ; 

PRINT_FIXED_MAT3X3 ( ’MXM(L,M) = ’ , MXM( L , M ) ) ; 
writeln ( LP ) ; 

PRIIn 1T_FIXED_MAT3X3 ( ’ MXMT( L , M ) = ’ , MXMT( L , M ) ) ; 
writeln < LP ) ; 

PRINT_FIXED_MAT3X3 ( ’ MTXM( L , M ) = ’ , I1TXM( L , M ) ) ; 
writeln ( LP ) ; 

PRINT_FIXED_MAT3X3 ( ’MINU(M) =\MINU(M) ) ; 
writeln ( LP ) ; 

N := MXM(h,MINU(M ) ) ; 

PRINT_FIXED_MAT3X3 ( *N - MXM( M, MINU( M ) ) =’,N ) ; 
writeln ( LP ) ; 

PRINT_FL0AT_NAT3X3 ( ’ MDIF( N , IDN3X3 ) = ’ , MDIF( N , IDN3X3 ) ) ; 

START_NEW_PAGE ; 
end ; 


vnAr'nC^/l Q 
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procedure TEST_UTILUEMQ_IhATQ_FUNCTION ; 


var 


i : integer i 


begin 

for i 1 to 9 do tAjritein ( L.P ) ; 

X CRSP(W,U) ; 

PRINT_FIXED_UECTOR ( ’X - CRSP(W,U) =’,X ) ; 
writein ( LP ) ; 

{1 234567800 12345B7S90 12 > 

uiriteln ( LP, ’ N13] = SXU( 0NE/WMAG( X ), X )’ ) ; 

uriteln ( LP, ’ Nil] = SXU( 0NE/UMA6( W ), W )’ ) ; 

uiriteln ( LP , * N121 = CRSP( NC31, NCll )' ) ; 

uiriteln ( LP ) ; 

NC3] := SXU( 0NE/UMAG( X ), X ) ; 

NCI ] := SXU( 0NE/UMAG( W ), W ) ; 

NC2] := CRSP( N133, NCll ) ; 

PRINT__FIXED_MAT3X3 ( ’N ) ; 

uiriteln ( LP ) ; 

{1234567890123456789012} 

uiriteln ( LP , ’ Q - IMATQ( N )’ ) ; 

uiriteln ( LP ) ; 

Q := INATQ( N ) ; 

PRINT_FIXED_SCALAR ( ’Q.S =’,Q.S ) ; 

PRINT_.FIXED_UECTOR ( ’Q.U =’,Q.U ) ; 
uiriteln ( LP ) ; 

{1234567890123456789012} 

uiriteln ( LP, ’ P = QCXQ< Q, Q )’ ) ; 

uiriteln ( LP ) ; 

P := QCXQ( Q, Q ) ; 

PRINT_FIXED_SCALAR ( ’P,5 =’,P.S ) ; 

PRINT_FIXED_UECTOR < ’P.U =’,P.U ) ; 
lAiriteln ( LP ) ; 

PRINT_FLOAT_SCALAR ( ’ONE - P.S -’,0NE-P.S ) ; 

PRINT_FLOAT_UECTOR ( ’ P.U =’,P.i; ) ; 
uiriteln ( LP ) : 

N MXMT( N, N ) ; 

PRINT_FIXED_MAT3X3 ( ’N = MXMT( N, N ) =’,N ) ; 
writeln ( LP ) ; 

PRINT_FL0AT_NAT3X3 ( ’ MDIF( N , IDN3X3 ) = ’ , NDIF( N , IDN3X3 ) ) ; 

START^NEW^PAGE ; 
end ; 
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procedure TESTJJTILUEHQ_EULER_QUAT_FUNCT IONS ; 


var 


i : integer ; 


beg i n 

for 1 1 to 9 do writeln ( LP ) 


PRINT^FIXED^EULARR ( ’PRY =’,PRY ) 
writeln ( LP ) ; 

PRINT_FIXED_EULARR ( ’RPR =’,RPR ) 
writeln ( LP ) ; 


<1234567890 123456789012} 


writeln ( LP , ’ P = 

writeln ( LP , ’ Q = 

writeln ( LP ) ; 

P := PRYQ(EULRAD(PRY) ) ; 

Q := RPRQ(EULRAD(RPR)) ; 


PRINT_FIXED_ 

SCALAR 

( 

’P.S =’, 

P.S 

) 

PRINT_FIXED_ 

OECTOR 

( 

’P.U =’ , 

P.U 

) 

tAiriteln < LP 

) ; 





PRINT_FIXED_ 

SCALAR 

( 

’Q.S =’, 

Q.S 

) 

PRINT_FIXED_ 

VECTOR 

( 

'Q.y =’, 

Q.U 

) 

writeln ( LP 

) ; 





PRINT_FIXED_ 

EULARR 

( 

'EULDEGC 

QPRY( 

writeln ( LP 

) ; 





PRINT_FIXED_ 

EULARR 

( 

’EULDEG( 

QRPR( 

for i := 1 to 5 do 

writeln ( 

LP ) 

; 


PRYQ( EULRAD( PRY ) ) ’ ) ; 
RPRQ( EULRAD< RPR ) )’ ) ; 


) ) =’,EULDEG( QPRY( P ) ) ) ; 
) ) ,EULDEG( QRPR( Q ) ) ) ; 


PRINT_FIXED_EULARR ( ’PYR =’,PYR ) ; 
writeln ( LP ) ; 

PRINT_FIXED_EULARR ( ’YRY -’,YRY ) ; 
writeln ( LP ) ; 

<1234567890123456789012} 

writeln ( LP, ’ P = PYRQ( EULRAD( PYR ) )’ ) ; 

writeln ( LP , ’ Q = YRYQ( EULRAD( YRY ) )’ ) ; 

writeln ( LP ) ; 

P PYRQ(EULRAD(PYR ) ) ; 

Q YRYQ(EULRAD(YRY)) ; 


PRINT_FIXED_SCALAR 

( 

’P.S =’, 

P.S ) ; 



PRINT_FIXED_UECTOR 
writeln ( LP ) : 

( 

'P.U =’ , 

P.U ) ! 



PRINT_FIXED_SCALAR 

( 

’Q.S =’, 

Q.S ) ; 



PRINT_FIXED_UECTOR 
writeln < LP ) i 

( 

’Q.U =’, 

Q.U ) ; 



PRINT_FIXED_EULARR 
writeln ( LP ) : 

( 

’EULDEG< 

QPYR< P ) ) =’ ,EULDEG( 

QPYR( 

P ) ) > 

PRINT_FIXED_EULARR 

( 

’EULDEG( 

QYRY< Q ) ) =’,EULDEG< 

QYRY( 

Q ) ) ) 


START_NEW_PAGE ; 
end ; 
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procedure TEST^UTILUEMQJNI QUAT^FUNCTION ; 


var 


i : integer ; 


begin 

for i := 1 to 8 do writeln ( LP ) ; 

P.S PI * R.S J 
P.K) := SXU( PI, R.U ) ; 

Q := UNIQUAK P ) ; 

{12345B789012345B789012) 

writeln ( LP, ’ P.S = PI ^ R.S’ ) ; 

writeln ( LP, ’ P.U = SXW( PI, R.U )’ ) ; 

writeln ( LP ) ; 

PRINT_FIXED_SCALAR ( ’P.S =’,P.S ) ; 

PRINT^FIXED^UECTOR ( ’P.U ) ; 

writeln ( LP ) ; 

(12345678901 23456789012} 

writeln ( LP , ’ Q = UNIQUAK P )’ ) ; 

lAiriteln ( LP ) ; 

PRINT_FIXED_SCALAR ( ’Q.S -’,Q.S > , 

PRINT^FIXEDJJECTOR ( ’Q.U = ’ , Q A' ) ; 
writeln ( LP ) ; 

R QXQC( Q, Q ) ; 

{1234567890123456739012} 

writeln ( LP, ’ R = QXQC( Q, Q )’ ); 

writeln ( LP ) ; 

PRINT_FLOAT_SCALAR ( ’ONE - R.S =’,ONE-R.S ) ; 
PRINT_FLOAT_UECTOR ( ’R.U =’,R.U ) ; 
for i := 1 to 5 do writeln ( LP ) ; 

end ; 


PRECEDING PAGE BLANK NOT FtLMtED 
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procedure TE3T_UTILUEMQ_MATRIX_DIAG0NALI ZATION 


var 


1 

MPB 

NERTENS_B 

NERTENS_P 

RPRBP 

RPRPB 


integer 

MAT3X3 

MAT3X3 

MAT3X3 

EULRPR 

EULRPR 


begin 

RPRPB := RPR ; 

PRINT_FIXED_EULARR ( ’RPRPB RPRPB ) : 
writeln ( LP ) ; 

NERTENS_P := K : 

PRINT_FIXED_MAT3X3 ( ’ NERTENS_P = ’ , NERTENS_P ) : 
writeln ( LP ) : 

HPB := QMAT( RPRQ( EULRAD( RPRPB ) ) ) ; 

NERTENS_B := MTXM( MPB, MXM( NERTENS_P, MPB ) ) i 
{1234567890123456789012} 

writeln ( LP, ' MPB = QMAT( RPRQ( EULRAD( RPRPB )>)’ ) : 

writeln ( LP, ’ NERTENS_B = MTXM( MPB,MXM( NERTENS_P , MPB))’ ) 

writeln ( LP ) ; 

PR1NT_FIXED_MAT3X3 ( ’NERTENS_B =’,NERTENS_B ) ; 


writeln ( LP 
S[ 1 1 
S121 
S131 


) 


S141 

S151 

SC6] 


NERTENS_8[ 1 , n ; 

( NERTENS_B12, 1 ] + NERTENS_B[1 , 2 1 ) / TWO ; 
NERTENS_B[2,21 ; 

( NERTENS_B[3, 1 ] + NERTENS_BC 1 , 3 1 ) / TWO ; 
( NERTENS_BC3,2] + NERTENS_B[ 2 , 3 1 ) / TWO : 
NERTENS_B[3,3] ; 

S = NERTENS_BC 1,1], 

NERTENS_B[ 2 ,11, NERTENS_B1 2 ,23, 
NERTENS_B[3,11, NERTENS_B[ 3 , 2 1 , 


NERTENS_B[3,31 ' 


) 


writeln ( LP , 
writeln ( LP , 
writeln ( LP , 
writeln ( LP ) ; 

DIAGONALIZE < S, 1 . 0L-8 , E, N ) ; 

{1234567890125456789012} 

writeln ( LP, ’ DIAGONALIZE ( S, 1.0L-8, E, N )’ 

writeln ( LP ) ; 

PRINT_FIXED_DIAG3X3 ( ’E =’,E ) : 
writeln ( LP ) ; 

RPRBP := EULDEG( QRPR< IMATQ( N ) ) ) ; 

{1234567890123456789012} 

writeln < LP , ’ RPRBP = EULDEG( QRPR< 1MATQ( N ) ) )’ ) 

writeln ( LP ) ; 

PRINT_FIXED_EULARR ( ’RPRBP =’, RPRBP ) : 


70 ) 
70 ) 
70 ) 


START_NEW_PAGE 
end ; 


{ end File 'Testvenq.I' } 
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$ page $ { begin File ’ Te s t s i. a t . T ’ > 

{ Utility Software Unit for HP-9000 Series 200/300/500 Computers > 

procedure TEST^UTILSTAT^MODULE ; 

{ NASA/JSC/hPAD/TRW San Wilson > 

{ Updated Sat Apr 12 22:39:45 1986 > 


var 


i : i nteger i 


begin 

for i := 1 to 2 do write-in ( LP ) ; 
writeln ( LP , ’ TEST„UT I LSTAT^MODULE ’ 49 ) 
for i := 1 to 5 do writeln ( LP ) ; 


RUNNUH := 1 ; 

START_RANDOM_NUMBER_SEQUENCE ( 454387819 ) ; 
TEST_UTILSTAT_UNIFORM_RANDOM_5CALAR_FUNCTION ; 
TEST_UTILSTAT_GAUSSIAN_RANDOH_SCALAR._FUNCT I ON ; 
TEST_UTILSTAT_SIXTUC_,NATRIX_FUNCTION ; 
TEST_UTILSTAT_GAUSSIAN_RANDON_SIXUECTOR_FUNCTION ; 


end ; 
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Page 2 


Printed 
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$ page $ 


procedure TESTJJTILSTAT_UNIFORM_RANDOM_SCAL AR 


cons t 


NIJMUALS - 1000 ; 

UNCERT = FIUE ; 

CLASS = CLASSARR [ 


CLASSREC 

[ 

UUB 

-5.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

-4.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

-3.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

-2.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

-1.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

0.0L0 , 

CDF 

CLASSREC 

C 

UUB 

1.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

2.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

3.0L0 , 

CDF 

CLASSREC 

[ 

UUB 

4.0L0 , 

CDF 

CLASSREC 

c 

UUB 

5.0L0 , 

CDF 


var 

A 

CPUTIhE 

E 

h 

k 

L 

M 

n 

DISTRIB 

X 

SAUTICK 

R 


integer ; 
longreal ; 
integer ; 
integer ; 
integer ; 

LINESTR ; 
integer ; 
integer ; 

array [ 0..10 1 of integer 
longreal ; 
integer 
1 onar ea 1 


FUNCTION ; 


0.0L0 ] , 
0.1L0 ] , 
0.2L0 ] , 
0.3L0 ] , 
0.4L0 ] , 
0.5L0 ] , 
0.BL0 ] , 
0.7L0 ] , 
0.8L0 ] , 
0-91.0 ] , 
1.0L0 ] ] ; 


vnnnmrcr i n 
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begin < procedure TESTJJTILSTnT_UNIFORH_RANDOM_SCALAR_FUNCTION > 

SHOWLN ( *’ ) ; 

for k := 0 to 10 do DISTRIBlk] ■'= 0 ; 

SAUTICK CPUTICK ; 
for n 1 to NUMUALS do 
begin 

if ( n mod 100 ) = 0 then 
begin 
L : = ” ; 

strwrite ( L , 1 , M / UNIFORM_RANDOM_SCALAR ’,n:5 ) ; 

CLEAR^LINE ; 

SHOW ( L ) ; 
end ; 

X := UNIFORM_RANDOM_SCALAR( UNCERT ) : 
for k 0 to 10 do 

if X <> CLASSCkl.UUB then 

DISTRIBEk] DISTRIBCk] + 1 ; 

end ; 

SHOWLN ( ” ) ; 

CPUTIME := ( CPUTICK - SAUTICK ) / TICKSPERSEC ; 
uriteln ( LP, ’Test UNIFORM_RANDOM_SCALAR Function’ :B7 ) ; 
for h 1 to 8 do writeln ( LP ) ; 

uiriteln ( LP, ’ CUMULATIUE DISTRIBUTION OF ’ : 40 , NUMUAL5 : 4 , 

’ PSEUDORANDOM NUMBERS’ ) ; 
writeln ( LP, ’FROM A’ :42 ) ; 

writeln ( LP, ’UNIFORMLY DISTRIBUTED POPULAT I ON ’ : 5S ) ; 
writeln ( LP, ’HAUING ZERO MEAN’:47 ) ; 
writeln ( LP , ’( UNCERTAINTY - ’ : 44 , UNCERT : 4 : 1 , ’ )’ ) ; 

writeln ( LP ) ; 

writeln ( LP , ’CPU Time = ’ : 40 , CPUTIME : 6 : 2 , ’ sec’ ) ; 
writeln < LP ) j 

writeln ( LP , ’ CLASS ACTUAL EXPECTED ACTUAL /’:G4 ); 

writeln ( LP , ’UPPER BOUND DISTRIBUTION DISTRIBUTION EXPECTED’^G4 ); 

writeln ( LP ) i 
for k 0 to 10 do 
begin 

A := DISTRIBCk] ; 

E round( NUMUALS * CLASS! kJ. CDF ) ; 
if A - E 

t hen 

R ONE 

else 
if E = 0 

then R 99999.9999 

else R A / E ; 

writeln ( LP , CLASS! k 1 . UUB: 20 : 1 , A : 14 , E : 14 , R : 15 : 4 ) ; 
end ; 

START_NEW_PAGE ; 

end ; < procedure TEST_UTILSTATJJNIFORM_RANDOM_SCALAR_FUNCTION > 
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procedure TEST_UTILSTAT_6AUSS I AN_RANDOM_SCALAR_FUNCTION ; 


const 


NUMUALS = 1000 

SI6MA = TEN 


CLASS = CLASSARR C 


CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

r 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 

CLASSREC 

[ 

UUB 


-25 

0L0 

CDF 

0 

00G21L0 

] 

1 

-20 

0L0 

CDF 

0 

0227BL0 

] 

I 

-15 

.0L0 

CDF 

0 

0GB81L0 

3 

1 

-10 

0L0 

CDF 

0 

1586GL0 

] 

» 

-5 

0L0 

CDF 

0 

308B4L0 

] 

I 

0 

0L0 

CDF 

0 

50000L0 

] 

1 

5, 

.0L0 , 

CDF 

0. 

.G9146L0 

3 

1 

10. 

.0L0 , 

CDF 

0, 

.84134L0 

3 

1 

15, 

.0L0 , 

CDF 

0, 

.93319L0 

3 

» 

20. 

.0L0 , 

CDF 

0. 

,97725L0 

3 


25, 

.0L0 , 

CDF 

0. 

•99379L0 

] 

3 


A 

integer 

CPUTIME 

longreal 

E 

integer 

h 

integer 

k 

integer 

L 

LINESTR 

M 

integer 

n 

integer 

DISTRIB 

array C 0 

X 

1 ongreal 

SAUTICK 

integer 

R 

longrea i 
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begin { procedure TE3T_UTILSTAT_GAUdSIAN_RAND0M_SCAL AR_FUNCTION > 
SHOWLN ( ” ) ; 

for k 0 to 10 do DISTRierkl := 0 : 

SAUTICK := CPUTICK ; 
for n := 1 to NUMUALS do 
begin 

if ( n mod 100 ) = 0 then 
begin 


strwrite ( L , 1 , M , ’ GAUSS I AN_RANDOri„SCALAR ’,n:E ) ; 

CLEARJ^INE ; 

SHOW ( L ) ; 
end ; 

X :== GAUSSIAN_RANDOM_SCALAR( SIGMA ) ; 
for k := 0 to 10 do 

if X <= CLASS [kl.UUB then 

DISTRIBCk] := DISTRIBlk] + 1 ; 

end ; 

SHOWLN ( ” ) ; 

CPUTIME := ( CPUTICK - SAUTICK ) / TICK5PERSEC ; 
for h := 1 to 7 do writeln ( LP ) ; 

writeln ( LP, ’Test GAUSS I AN_RAND0M_3CALAR Function’ =57 ) ; 
for h := 1 to 8 do writeln ( LP ) ; 

writeln ( LP , ’ CUMULATIUE DISTRIBUTION OF 40 , NUMUALS 4 , 

’ PSEUDORANDOM NUMBERS’ ) ; 
writeln ( LP, ’FROM A’ :42 ) ; 

writeln ( LP, ’NORMALLY DISTRIBUTED POPULAT ION ’ : 55 ) ; 
writeln ( LP, ’HAUIN6 ZERO MEAN’:47 ) i 

writeln ( LP , ’( SIGMA = ’ : 4 1 , S IGMA •' 4 : 1 , ’ )’ ) ; 

writeln ( LP ) i 

writeln ( LP , ’CPU Time - ’ : 40 , CPUTIME : 6 : 2 , ’ sec’ ) ; 
writeln ( LP ) ; 

writeln ( LP, ’ CLASS ACTUAL EXPECTED ACTUAL / ’ : 64 ); 

writeln ( LP, ’UPPER BOUND DISTRIBUTION DISTRIBUTION EXPECTED’: 64 ); 

writeln ( LP ) ; 
for k := 0 to 10 do 
begin 

A := DISTRIBlk] ; 

E := round( NUMUALS * CLASStk 3 . CDF ) ; 
if A = E 

t hen 

R := ONE 

else 
if E = 0 

then R := 99999.9999 
elseR :=A/E; 

writeln ( LP , CLASS [ k 3 . UUB : 20 : 1 , A : 14 , E : 1 4 , R : 15 : 4 ) ; 
end ; 

START_NEW_PAGE ; 

end ; { procedure TEST_UTILSTAT_GAUSSIAN_RANDOM_SCALAR_FUNCTION > 
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procedure TEST_lJTILSTAT_SIXTUC„MnTRIX_FUNCTION ; 


conet 


STXPOPIN - SIXPOPDFF C 


1 . 00000L0 , 
0.48B50L0, 
0.53460L0, 
-0.47810L0, 
-0.19910L0, 
“0,4G049L0, 


1 . 00000L0 , 
0.B9872L0, 
“0.99G1SL0, 
-0.GG1GBL0, 
-0.77813L0, 


J .0000010, 
-0.70584L0, 
-0.6270GL0, 
“0.87129L0, 


1 .00000L0, 
0.6G691L0, 
0.78915L0, 


1 .00000L0, 
0.72009L0, 


var 


h 

i 

i j 

j 

k 

ki 

kj 

SIXTUC 

SIXPOPOUT 


i nt eger 

integer 

integer 

integer 

integer 

integer 

integer 

TRIANGGXG 

SIXPOPDEF 


1.00000L0 ]; 
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begin { procedure TEST_UT ILSTAT_SIXTUC_nATRIX_FUNCTION > 

for h := 1 to 6 do writeln ( LP ) ; 

writeln ( LP , ’Test S I XTUC J1ATRI X Function’ :53 ) ; 

for h := 1 to 7 do uiriteln ( LP ) ; 

PRINT_FIXED_SIXPOP ( ’SIXPOPIN =’,SIXP0PIN ) ; 

for h := 1 to 2 do writeln ( LP ) ; 

try 

SIXTUC SIXTUC_NATRIX{ SIXPOPIN ) ; 
writeln ( LP, ’ SIXPOPOUT =’:22, 

’ T * M , where M is SIXTUC_MATRIX( SIXPOPIN )’ ) ; 
writeln ( LP, ” =22, 

’ and T is the transpose of N.’ ) ; 

for h := 1 to 2 do writeln ( LP ) ; 
for i := 1 to 6 do 

for j := 1 to i do 
begin 

ij := TRIANG_INDEX< i, j ) ; 

SIXPOPOUTCij] := ZERO ; 
for k := 1 to j do 
begin 

ki TRIANG_INDEX< k, i ) ; 
kj := TRIANG__INDEX( k, j ) ; 

SIXPOPOUT! ij ] := SIXPOPOUT! ij ] +■ SIXTUC!kil ^ 

SIXTUCIkj] ; 

end ; 

end ; 

PRINT_FIXED_SIXPOP ( ’SIXPOPOUT =’, SIXPOPOUT ) j 
for h := 1 to 2 do writeln ( LP ) ; 
for i := 1 to 6 do 

for j 1 to i do 
beg i n 

ij TRIANG_INDEX( i, j ) ; 

SIXPOPOUT! ij ] ab5( SIXPOPOUTCij] - SIXPOPINCij] ) ; 
end ; 

PRINT_FLOAT_SIXPOP ( ’ ! S I XPOPOUT-SIXPOP IN I SIXPOPOUT ) ; 
for h := 1 to 2 do writeln ( LP ) ; 

recover 

writeln ( LP , ’escapecode = ’ , escapecode : 1 ) ; 

START^NEW^PAGE ; 

end ; < procedure TEST_UTILSTAT__SIXTUC_MATRIX_FUNCTION > 
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procedure TEST_UTILSTAT_GAUSSIAN_RANDOM._SIXIJECTOR_FUNCTION ; 
const 


MAXPOPS = 3 ; 

NUMt/ALS = 1000 : 

type 

POPIDNIJM = 1.. MAXPOPS : 

POPIDTEXTARR = array [ POPIDNUM ] of LINESTR ; 
SIXPOPDEFARR = array [ POPIDNUM I of SIXPOPDEF : 


const 


POPIDTEXT = POPIDTEXTARR [ 

LINESTR [ ’ASTP / Apollo STDN 2-Station Estimation Error ’ ], 

LINESTR I ’RAIDS / Long-Range Stationkeep without TIC ; 0.5 deg Deadbands' 1, 

LINESTR t 'RAIDS / Long-Range Stationkeep with TIC : 3.0 deg Deadbands ’ ll: 

SIXPOPIN = SIXPOPDEFARR C 


{ ASTP / Apollo STDN 2-Station Estimation Error } 


0. 11363L0, 

0.72009L0, 0.41689L0 1, 

< RAIDS / Long-Range Stationkeep without TIC ; 0.5 deg Deadbands > 


0.07300L0, 

-0.36069L0, 0.02B00L0 1, 


< RAIDS / Long-Range Stationkeep with TIC ; 3.0 deg Deadbands > 


SIXPOPDEF I 

75.30095L0, 
0.48650L0, 
0.53460L0, 
-0.47810L0, 
-0. 19910L0, 
-0.4B049L0, 

SIXPOPDEF [ 

10. 10000L0, 
0.3759BL0, 
-0. 19199L0, 
-0.40541L0, 
0.55319L0, 
-0 .34093L0 , 

SIXPOPDEF [ 

B.90000L0, 

0.43070L0, 

0.30076L0, 

-0.4BB84L0, 

0.51904L0, 

-0.07188L0, 


179.9058BL0, 

0.69872L0, 

-0.99B18L0, 

-0.EB1B5L0, 

-O.77813L0, 


40 . 30000L0 , 
0. 1B483L0, 
-0.B522BL0, 
-0.05193L0, 
0.27385L0, 


27.80000L0, 

0.09788L0, 

-0.3B040L0, 

0.51485L0, 

0.05597L0, 


79.85549L0, 

-0.70584L0, 

-0.6Z70BL0, 

-0.87129L0, 


11.90000L0, 
-0.08834L0, 
-0.35843L0, 
0. 18710L0, 


6.90000L0, 
0 . 33187L0, 
0.32888L0, 
0 . 3B320L0 , 


0. 18992L0, 
0.B6B91L0, 
0.78915L0, 


0.0G300L0, 

0.0B77BL0, 

-0.2077GL0, 


0.04200L0, 
0. 103991.0, 
0.0G798L0, 


0.06300L0, 

-0.01471L0, 


0.02400L0] 1; 


¥E334C5B4 
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var 


COUAROUT 

array C 1 

CPUTIME 

longreal 

h 

integer 

i 

integer 

i i 

integer 

i j 

int eger 

j 

integer 

j J 

integer 

k. 

integer 

L 

LINESTR 

M 

i nteger 

population 

POPIDIMUM 

SIXTUC 

TRIAN66X6 

n 

integer 

SAUTICK 

integer 

SIXPOPOUT 

SIXPOPDEF 

U 

SIXUEC 


of longreal ; 


begin { procedure TEST_UTILSTAT^_GAUSSI ANLRANDOM^SIXUECTOR^FUNCTION 
for population := 1 to 3 do 
begin 

SHOUILN ( ” ) ; 

for h := 1 to 6 do uritein < LP ) ; 

writeln ( LP , ’Test GAUSS lAN^RANDOM^IXUECTOR Function’ :59 ) ; 
for h := 1 to 3 do writeln ( LP ) ; 

writeln ( LP, TENSPACES , ’ ’ , POPIDTEXTE populat ion 3 ) ; 
for h := 1 to 3 do writeln ( LP ) ; 

PRINT_FIXED_SIXPOP ( ’SIXPOPIN = ’ , SIXPOPINf populat ion 3 ) ; 
for h := 1 to 2 do writeln ( LP ) ; 
for i := 1 to 6 do 

for j := 1 to 6 do 

C0UAR0UT[i,j3 := ZERO ; 

SAUTICK := CPUTICK ; 


1986 


¥47EC7A6C 
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try 



SIXTUC := SIXTUC_MATRIX( SIXPOPTNC populat ion ] ) ; 
for n := 1 to NUMUALS do 
begin 

if ( n mod 100 ) = 0 then 
begin 
L ; 

strwrite ( L , 1 , M , ’ GAUSSI AN_RAND0M.3IXUECT0R \n:5 ) ; 
CLEAR^LINE ; 

SHOW ( L ) ; 
end ; 

U := GAUSSIAN_RAIMDOM_SIXUECTOR( SIXTUC ) ; 
for i 1 to G do 

for j := 1 to G do 

COOAROUTi i , j ] := COUAROUTC i , j ] + UCil ♦ UCj] ; 

end J 

SHOWLN ( ” ) ; 

CPUTIME ( CPUTICK ~ 5AUTICK ) / TICKSPERSEC ; 
writeln ( LP, ’ SIXPOPOUT =’:22, 

’ statistical summary of ’,NUMUAL5:4, 

* pseudorandom ’ ) ; 

writeln ( LP , ’’:22,’ six-vectors from population defined by’, 

’ SIXPOPIN’ ) ; 

for h 1 to 2 do writeln ( LP ) ; 

writeln ( LP, ’CPU time = ’ : 23 , CPUTIME : 4 : 2 , ’ sec’ ) j 
for h := 1 to 2 do writeln ( LP ) ; 
for i := 1 to 6 do 

for j 1 to G do 

COUAROUTC i ,j ] := COUAROUTC i ,j ] / NUMUALS ; 
for j := 1 to G do 
begin 

j j := TRIANG_INDEX( j , j ) ; 

SIXPOPOUTC J j ] sqrt( COUAROUT C j , j ] ) ; 
end ; 

for j 1 to 5 do 
begin 

j j := TRIANG_INDEX( j , j ) ; 
for i : = j+1 to 6 do 
begin 

ii := TRIANG_INDEX( i, i ) ; 
i j := TRIANG_INDEX( i , j ) ; 

SIXPOPOUTCij ] := COUAROUTC i ,j 3 / 

(SIXP0P0UTCii3*SIXP0P0UTC jj] ) ; 

end ; 

end ; 

PRINT^FIXED^SIXPOP ( ’SIXPOPOUT SIXPOPOUT ) ; 



{ 


recover 

writeln ( LP , ’escapecode = ’ ,e5capecode: 1 ) ; 

START_NEW_^PAGE ; 
end ; 

end ; < procedure TESTJJTILSTAT_^GAUSSI AN..^RANDOM_SIXUECTOR_FUNCTION > 
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Utility Software Unit Test 


Run 


Sat Apr 12 22 ^ B5 : 35 


TEST_UTILMATH_MODULE 


INK - 

-2.3 

) 

= 

-3 

INK - 

-2.0 

) 


-2 

INK - 

-0.3 

) 


-1 

INK 

0.0 

) 

= 

0 

INK 

1.3 

) 


1 

FRAC( - 

•2 . 3 

) 

= 

0.70 

FRAC( - 

■2.0 

) 


0.00 

FRAC( - 

■0.3 

) 


0.70 

FRAC( 

0.0 

) 


0.00 

FRAC( 

1.3 

) 


0.30 

RNOD( -2.8, •’ 

•0.5 

) 

=: 

-0.30 

RM0D( -2.8, 

0.0 

) 


0 . 00 

RMOD( -2.8, 

0.5 

) 

= 

0.20 

RN0D( 2.8, - 

■0.5 

) 

~ 

-0.20 

RM0D( 2.8, 

0.0 

) 

=: 

0 . 00 

RM0D( 2.8, 

0.5 

) 


0.30 

RSI6N( - 

•1.9 

) 


-1 

RSI6N( 

0.0 

) 


1 

RSIGN( 

1 . 9 

) 

= 

1 

I5IG1\1( 

-5 

) 


-1 

ISI6N( 

0 

) 


1 

ISIGN( 

5 

) 


1 

IMAX( -5, 

-4 

) 


-3 

INAX( 3, 

4 

) 

= 

4 

ININ( -3, 

-4 

) 

= 

-4 

IMIN( 3, 

4 

) 


3 

RMAX( -2.9, • 

3.9 

) 


-2.90 

RmX( 2.9, 

3.9 

) 

= 

3.90 

RMIN( -2.9, - 

3.9 

) 


-3.90 

RMIN( 2.9, 

3.9 

) 


2.90 


198B 
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¥9F9DBC30 


ANGDE6(0NE> = 
AN6RAD(AN6DEG(0NE) )-ONE = 

AN6DE6( ANG1(-THREE*TW0PI-HAFPI ) ) = 
AN6DEG(ANG2( THREE*TWOPI-HAFPI ) ) = 

ANGDEG< ATAN1(-SIX,SIX ) ) = 
ANGDE6(ATAN2<-SIX,SIX ) ) = 

HMS( -36385. 874L0 ) = 
HMS( 36385. 874L0 ) = 

SECS( -1006.25874L0 ) = 
SECS( 1006.25874L0 ) = 

JULIAN_DAYNUM( 1980, 4, 2 ) = 


1 3B 


57.2957795130823 

-2.2E-016 

270.000000000000 
-90 . 000000000000 

315 . 000000000000 
-45.000000000000 

-1006.258740 

1006.258740 

-36385.874000 

36385.874000 

2444332 


File ’UTILTEST.R’ Page 


1986 


Printed Wed Apr 16 09=42:22 


TF5T_UTILSPTF_M0DULE 


"San Wilson" 
"29 

"Ben Wheeler" 
"N" 

254.11112000 


START_RAND0M_NUMBER_5EQUENCE ( 1 ) 
Pseudorandom integers: 

16807 

282475249 

1B22650073 

984943658 

1144108930 

470211272 

101027544 

1457850878 

1458777923 

2007237709 


START_RANDOM_NUMBER_SEQUENCE ( 2147483646 ) 


Pseudorandom integers: 


2147466840 

1865008398 

524833574 

1162539989 

1003374717 

1677272375 

2046456103 

689632769 

688705724 

140245938 


1 3 B 


U4759AD5 


File ’UTILTEST.R’ Page 4 


Printed Wed Apr IG 09:42:22 


198G 


U = 
W = 

DOTP(U,W) - 
UMAG(U) = 
SXU(TWO,U) - 
CRSP(U,W) = 
UDIF(U,W) = 
USUM(U,W) - 

D = 
UXD(U,D) = 

H = 

uxn(u,M) = 

UXMT(U,M) = 


TEST_UTILUEMQ_MODULE 


2 . 0000000000000 

4.0000000000000 
- 25 . 0000000000000 

7.0000000000000 

4 . 0000000000000 
-9.0000000000000 
“ 2 . 0000000000000 

B. 0000000000000 

30 . 0000000000000 

60 . 0000000000000 

1 .0000000000000 

4.0000000000000 

7.0000000000000 

- 1.0000000000000 

1 1 . 0000000000000 


- 6 . 0000000000000 

5 . 0000000000000 

- 12.0000000000000 

14 . 0000000000000 
- 11 .0000000000000 

- 1 .0000000000000 

10.0000000000000 
- 60 . 0000000000000 

3 . 0000000000000 

5 . 0000000000000 

8.0000000000000 


3.0000000000000 
- 1.0000000000000 

6.0000000000000 

34 . 0000000000000 

4 . 0000000000000 

2.0000000000000 

40 . 0000000000000 

120 . 000000000000 

9 . 0000000000000 

6 . 0000000000000 

2 . 0000000000000 


0 . 0000000000000 - 12 . 0000000000000 
-4 . 0000000000000 -28 . 0000000000000 


¥D090C290 


1 - 4-0 



File ’UTILTEST.R’ Page 5 


Printed Wed Apr IB 09:42=22 1986 


L = 


MDIF(L,M) = 


MSUM(L,M) = 


MXM(L,M) = 


MXMT(L,M) = 


MTXM(L,M) = 


MINU(M) = 


N = hXM(ri,MINU(M) ) = 


MDIF(N,IDN3X3) = 


1 . 0000000000000 
- 2.0000000000000 

4.0000000000000 

0.0000000000000 
- 6.0000000000000 
-5 . 0000000000000 

2 . 0000000000000 

2 . 0000000000000 

11.0000000000000 

- 12.0000000000000 

60.0000000000000 

- 12.0000000000000 

- 20 . 0000000000000 

67 . 0000000000000 
-23.0000000000000 

21 .0000000000000 

43 , 0000000000000 
-7 . 0000000000000 

-1 .0270270270270 
0.9189189189189 
-0.0810810810811 

1 . 0000000000000 
0 . 0000000000000 
0.0000000000000 

-3.3E-016 

1.11E-01G 

2.78E-017 


2,0000000000000 

5 . 0000000000000 

3 . 0000000000000 

-1 . 0000000000000 
0.0000000000000 
-5 . 0000000000000 

5 . 0000000000000 

10 . 0000000000000 

11 .0000000000000 

-11.0000000000000 

67.0000000000000 
-5 . 0000000000000 

- 4 . 0000000000000 

53 . 0000000000000 

7.0000000000000 

25 . 0000000000000 

55.0000000000000 
-11. 0000000000000 

1,7837837837838 

-1.648648G48G48G 

0.3513513513514 

0.0000000000000 

1 . 0000000000000 
0.0000000000000 

0.00E+000 

4.44E-01G 

-7.8E-01G 


“3 . 0000000000000 

6 , 0000000000000 
-4.0000000000000 

-12 . 0000000000000 
0 . 0000000000000 
■•'6 . 0000000000000 

B , 0000000000000 
12.0000000000000 
”2 . 0000000000000 

1 5 . 0000000000000 

24.0000000000000 

46 . 0000000000000 

17.0000000000000 

38 . 0000000000000 

44.0000000000000 

5 . 0000000000000 

54 . 0000000000000 

1 .0000000000000 

-0.7297297297297 

0.8108108108108 

-0.1891891891892 

0.0000000000000 
0 . 0000000000000 

1 ,0000000000000 

0 . 00E+000 
0 . 00E+000 
4.44E-016 


¥05806580 


1^1 



File MJTILTEST.R’ Page B 


Printed Wed Apr 16 09:42^22 198G 


X = CRSP(W,U) = 

N131 = 
Nil] = 
N[21 = 

N = 


Q = 

Q.S = 
Q.U - 

P = 

P.S = 
P.'J- 

ONE “ P.S = 
P.W - 

N = NXNT( N, N ) = 
MDIF(N,IDN3X3) = 


9 . 0000000000000 

SXU( ONE/UNAG( X ), 
SXU( ONE/UMAG( W ), 
CRSP( N[3], Nil] ) 

0.6172133998484 

0.7500152304084 

0.2377493915935 

IMATQ( N ) 

0.2243743946150 

0.8707828839414 

QCXQC Q, Q ) 

1 .0000000000000 
0 . 0000000000000 

-2.2E-016 
0 . 00E+000 

1 .0000000000000 
0.0000000000000 
0.0000000000000 

0 . 00E+000 
0 . 00E+000 
-2.8E~017 


-14 . 0000000000000 

X ) 

W ) 


0.7715167498105 

-0.5176735557710 

-0.3698323869232 


0.4368287457982 


0 , 0000000000000 


0 . 00E+000 

0 . 0000000000000 
1 .0000000000000 
0.0000000000000 

0 . 00E+000 
0 . 00E+000 
0 . 00E+000 


-34 . 0000000000000 


-0.1543033499621 

0.4116931427785 

-0.8981643682420 


0.0239571893207 


0 . 0000000000000 


0 . 00E+000 

0.0000000000000 
0 . 0000000000000 
1 . 0000000000000 

-2.8E-017 
0 . 00E+000 
-2.2E-016 


¥FEFB919B 


1^2 



File ’UTILTEST.R 


Page 7 


Printed Wed Apr IG 09:42:22 1986 






PRY 


-145 

. 000000000000 

G5 . 0000000000000 

-170 

. 000000000000 




RPR 


10. 

0000000000000 

-15 . 0000000000000 

20. 

0000000000000 




P 


PRYQ( 

EULRAD< PRY > 

) 






Q 

= 

RPRQ( 

EULRAD( RPR ) 

) 






P.S 


0. 

5325855897G93 







P.U 

= 

0. 

8153775734730 

0.0908499818748 

-0. 

20798G2568553 




Q.S 

=: 

0. 

957BG219B9425 







Q.U 

= 

0. 

25GB04812292G 

-0.1300295006517 

0. 

01137B1072310 

EULDEG< 

QPRY( 

P 

) ) 

= 

-145 

.000000000000 

65.0000000000000 

-170 

. 000000000000 

EULDEG< 

QRPR( 

Q 

) ) 


-170 

. 000000000000 

15 . 0000000000000 

-160 

. 000000000000 



EULDEG( QPYR< 
EULDEG( QYRY( 



PYR 


80.0000000000000 

““35.0000000000000 

120. 000000000000 

YRY 


-5 . 0000000000000 

80 . 0000000000000 

-55 ■ 0000000000000 

P 

=: 

PYRQ( EULRAD( PYR ) 

) 


Q 

= 

YRYQ< EULRAD( YRY ) 

) 


P.S 


0.532B8S802B743 



P.V 

=: 

0.5360G414B6904 

0.1070262978581 

-0.G460829990840 

Q.S 


0.B634139481689 



Q.V 

= 

0.5825G34160G9G 

0.271G537822742 

-0.3830222215595 

) ) 

= 

80.0000000000000 

"“35 . 0000000000000 

120 . 000000000000 

) ) 

= 

-5.0000000000000 

80 . 0000000000000 

-55 , 0000000000000 


Y5EB5D815 


143 



File ’UTILTEST.R’ Page 8 


Printed 


Wed Apr 16 09:42=22 1986 


¥3C35EA95 


R 

= 

QCXO< P, Q ) 



R.S 


0.9422227864928 



R.U 


-0.1798248634331 

0.2447640278487 

0.1413145773664 

R 


QXQC( P, Q ) 



R.S 


0.9422227864928 



R.U 


-0.089210016S536 

0.0973556494454 

-0.3078630719675 

R 


QXQ( P, Q ) 



R.S 

= 

-0.2354364230378 



R.U 

= 

0.8004748806090 

0.0446498281944 

-0.5493778745667 

QMAT( R ) 


0.3923806875575 

-0.1872049915819 

-0.9005507687847 



0.3301692551544 

-0.8851521670988 

0.3278626298179 



-0.8585019854273 

-0.4259811406708 

-0.2855072832874 

N 

= 

MDIF( QMAT(R), MXM( QMAT( P ) , QMAT( Q ) ) ) 


N 


1 . llE-016 

1 .67E-01B 

l.llE-016 



0.00E+000 

0 . 00E+000 

0.00E+000 



2.22E-01B 

1 .67E-016 

-l.lE-016 

ROT(U,Q ) 

= 

-0.1519683046476 

3.1770527943276 

6.2356428037884 

IROT(U,Q) 


-4.0877962276343 

-3.4935338305642 

-4.4816451640041 

X 

= 

UDIF( U, IROT(ROT(U,Q),Q) > 


X 


0.00E+000 

-1.8E-015 

8.88E-01B 


1 -4.-4 


File ’UTILTEST.R’ Page 9 


Printed Wed Apr 16 09=42:22 1986 


P.S = PI * R.S 
P.U = SXt;( PI , R.U ) 

P.S = -0.7396453370029 

P. U = 2.5147660043043 0.1402715722396 -1.7259214947836 

Q = UNIQUAK P ) 

Q. S = -0.2354364230378 

Q.U = 0.8004748806090 0.0446498281944 -0.5493778745667 

R = QXQC( Q, Q ) 


ONE - R.S 

R.U 


0 . 00E+000 



0.00E+000 

0 . 00E+000 

0.00E+000 


RPRPB 


10 . 0000000000000 -15 . 0000000000000 


20.0000000000000 


NERTENS_P = 25.0000000000000 0.0000000000000 

0.0000000000000 40,0000000000000 

0.0000000000000 0.0000000000000 


0.0000000000000 
0 . 0000000000000 
55.0000000000000 


MPB 

NERTENS_B 


QMAT(RPRQ(EULRAD( RPRPB ))) 
MTXM( MPB,MXM( NERTENS_P, MPB)) 


NERTENS B 


26.9793202303121 

3.1503479728235 

6.7143670804884 


3.1503479728235 

43.4622804063605 

5.7920928450464 


6.7143670804884 

5.7920928450464 

49.5583993633275 


S = NERTENS_BC1,1], 

NERTENS_Bt2,l], NERTENS_B[ 2 ,2 I , 

NERTENS_BC3,1], NERTENS_B[ 3 , 2 1 , NERTENS_BI 3 , 3 1 


DIAGONALIZE < S, 1.0L-8, E, N ) 


E = 25.0000000000000 40.0000000000000 

RPRBP = EULDE6( QRPR< IMATQ( N ) ) ) 

RPRBP = -20.0000000000000 15.0000000000000 


55 . 0000000000000 


-9.9999999957838 


¥5EC086C0 


1 4B 



File ’UTILTEST.R’ Page 10 


Printed Wed Apr 16 09:42:22 1986 


TEST UTIL ST AT MODULE 


Test UNIFORM_RANDOM_SCALAR Function 


CUMULATIVE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

UNIFORMLY DISTRIBUTED POPULATION 
HAVING ZERO MEAN 
( UNCERTAINTY = 5.0 ) 

CPU Time = 


CLASS 

ACTUAL 

EXPECTED 

ACTUAL / 

ER BOUND 

DISTRIBUTION 

DISTRIBUTION 

EXPECTED 

-5.0 

0 

0 

1.0000 

-4.0 

103 

100 

1 . 0300 

-3.0 

215 

200 

1.0750 

-2.0 

328 

300 

1.0933 

-1.0 

412 

400 

1 . 0300 

0.0 

513 

500 

1.0260 

1.0 

602 

600 

1 . 0033 

2.0 

704 

700 

1.0057 

3.0 

809 

800 

1.0113 

4.0 

912 

900 

1.0133 

5.0 

1000 

1000 

1 . 0000 


¥E251B871 


1 4^G 



File ’UTILTEST.R’ Page 11 


Printed Wed Apr 16 00:42=22 1986 


¥68788478 


Test GAU5SIAN_RAND0M_SCALAR Function 


CUMULATIVE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

NORMALLY DISTRIBUTED POPULATION 
HAVING ZERO MEAN 
( SIGMA = 10,0 ) 


CPU Tine = 5.81 sec 


CLASS 

ACTUAL 

EXPECTED 

ACTUAL / 

UPPER BOUND 

DISTRIBUTION 

DISTRIBUTION 

EXPECTED 

-25.0 

6 

G 

1 . 0000 

-20.0 

21 

23 

0.9130 

-15.0 

63 

67 

0.9403 

-10.0 

14B 

159 

0.9182 

-5.0 

298 

309 

0.9644 

0.0 

485 

500 

0.9700 

5.0 

687 

691 

0.9942 

10.0 

841 

841 

1 .0000 

15.0 

937 

933 

1.0043 

20.0 

981 

977 

1.0041 

25.0 

994 

994 

1 . 0000 


1 4-T 



File ’UTILTEST.R’ 


Page 12 


Printed Wed Apr 16 09^42:22 1986 


Test SIXTUC_MATR1X Function 


SIXPOPIM = 


SIXPOPOUT = 


SIXPOPOUT = 


1 SIXPOPOUT-SIXPOPINI = 


1.000 

0.487 

0.535 

-0.478 

-0.199 

-0.460 


T * M , 


1.000 

0.487 

0.535 

-0.478 

-0.199 

-0.460 


0.0E+000 
0 . 0E+000 
0 . 0E+000 
0.0E+000 
0.0E+000 
0 . 0E+000 


1.000 

0.699 

-0.996 

-0.662 

-0.778 


1.000 

0.699 

-0.996 

-0.662 

-0.778 


0.0E+000 
0 . 0E+000 
0 . 0E+000 
0.0E+000 
0.0E+000 


1.000 
-0 . 706 
-0.627 
-0.871 


1.000 

-0.706 

-0.627 

-0.871 


0 . 0E+000 
0 . 0E+000 
0.0E+000 
1 . lE-016 


1.000 

0.667 

0.789 


1.000 

0.667 

0.789 


0.0E+000 

0.0E+000 

l.lE-016 


1.000 

0.720 


1.000 

0.720 


2.2E-016 

l.lE-016 


where M is SIXTUC_MATRIX( SIXPOPIN ) 
and T is the transpose of M. 


1.000 


1.000 


.0E+000 


¥88583338 


1 



File ’UTILTEST.R’ Page 13 


Printed Wed Apr IG 03:42:22 1986 


Test GAUSSIAN_RANDON_SIXUECTOR Function 


ASTP / Apollo STDN 2"'5tation Estimation Error 


SIXPOPIN = 

7B.301 






0.487 

179.906 





0.535 

0.699 

79.855 




-0.478 

-0.996 

-0.706 

0.190 



-0.199 

-0.662 

-0.627 

0.667 

0.114 


-0.4G0 

-0.778 

-0.871 

0.789 

0.720 


SIXPOPOUT 


statistical summary of 1000 pseudorandom 
six-vectors from population defined by SIXPOPIN 


CPU time - 


64,13 sec 


SIXPOPOUT = 76.626 

0.B04 
0.567 
-0.498 
- 0,222 
-0.473 


183. 

.598 




0, 

.711 

79. 

.939 


-0. 

.996 

-0. 

.720 

0 

-0. 

.671 

-0. 

.640 

0 

-0. 

.787 

-0. 

.875 

0 


193 

677 0.113 

798 0.729 0.415 


¥A6BF815F 


1 A B 



File ’UTILTEST.R’ Page 14 


Printed Wed Apr 16 09:42:22 1986 


Teat GAU5SIAN_RANDOI4_5IXUECTOR Function 


RAIDS / Long-Range Stationkeep without TIC ; 0.5 deg Deadbands 


SIXPOPIN 


10. 

,100 



0, 

.376 

40. 

300 

-0. 

,192 

0. 

165 

-0. 

,40S 

-0. 

652 

0. 

. 553 

-0. 

052 

-0. 

,341 

0. 

274 


1 1 . 900 

-0 . 088 0.063 

-0.358 0.068 

0.187 -0.208 


0.073 

-0.361 0.026 


SIXPOPOUT 


statistical sunnary of 1000 pseudorandom 
six-vectors from population defined by SIXPOPIN 


CPU tine 


64.10 sec 


SIXPOPOUT - 10.162 

0.345 
- 0.201 
-0.398 
0.576 
-0.414 


38.759 



0.126 

11.897 


-0.607 

-0.025 

0 

-0.019 

-0.345 

0 

0.237 

0.198 

-0 


0B1 

052 0.072 

141 -0.389 0.026 


¥8857F2B7 


1 50 



File ’UTILTEST.R’ Page IS 


Printed Wed Apr 16 09:42:22 1986 


Test GAUSSIAN_RANDOM_SIXUECTOR Function 


RAIDS / Long-Range Stationkeep with TIC ; 3.0 deg Deadbands 


SIXPOPIN = 6.900 


0, 

.431 

27, 

,800 







0. 

.301 

0, 

,098 

6 . 

,900 





-0, 

.467 

-0, 

,360 

0, 

, 332 

0, 

,042 



0, 

.519 

0, 

,51 

0. 

,329 

0. 

, 104 

0, 

,063 

-0, 

.072 

0, 

,056 

0, 

,363 

0, 

,068 

-0, 

,015 


SIXPOPOUT = statistical summary of 1000 pseudorandom 

six-vectors from population defined by SIXPOPIN 


CPU time = 64.10 sec 


SIXPOPOUT 


6.884 

0.422 

0.331 

-0.489 

0.523 

-0.042 


27.852 

0.101 

-0.311 

0.544 

0.067 


6.925 

0.286 

0.336 

0.411 


0.042 

0.107 

0.102 


0.063 

0.002 0.024 


¥0FE9B2C9 


15 1 



File ’UTILTEST.R’ Page 16 


Printed 


Wed Apr 16 09:42;22 1986 


Tests completed 

Elapsed time = 302.88 seconds 


¥F678B978 


1 Ei2 


File ’utiltest.R’ Page 1 
Utility Software Unit Test 


Printed 

Ued 

Apr 

16 

09:47:15 

1986 

Run 

T Li e 

Apr 

15 

10:05:44 

1986 


TEST_UTILMATH_MODULE 


INK - 

-2.3 

) 

= 

-3 

INK - 

-2.0 

) 

= 


INK - 

-0.3 

) 


-1 

INK 

0.0 

) 

= 

0 

INK 

1.3 

) 

= 

1 

FRAC< - 

-2.3 

) 


0.70 

FRAC( - 

-2.0 

) 


0.00 

FRAC( - 

-0.3 

) 


0.70 

FRAC< 

0.0 

) 

= 

0 . 00 

FRAC( 

1.3 

) 


0.30 

RMOD( -2,8, - 

■0.5 

) 


-0.30 

RM0D( -2.8, 

0.0 

) 

= 

0.00 

RMOD( -2.8, 

0.5 

) 

2= 

0.20 

RNOD( 2.8, - 

■0.5 

) 


-0.20 

RM0D< 2.8, 

0.0 

) 


0 . 00 

RM0D( 2.8, 

0.5 

) 


0 . 30 

RSIGN( - 

■1 . 9 

) 


-1 

RSIGN( 

0.0 

) 


1 

RSIGN( 

1.9 

) 


1 

I5IGN( 

-5 

) 


-1 

I5IGN( 

0 

) 

= 

1 

ISIGN( 

5 

) 

- 

1 

1 — 1 

3 > 

X 

! 

-4 

) 


-3 

IMAX( 3, 

4 

) 

- 

4 

IMIN( -3, 

-4 

) 

S= 

-4 

IMIN( 3, 

4 

) 

= 

3 

RMAX( -2.9, - 

3.9 

) 


-2.90 

RMAX( 2.9, 

3.9 

) 


3.90 

RMIN< -2.9, - 

3.9 

) 


-3.90 

RMIN( 2.9, 

3.9 

) 

= 

2.90 


¥436B9E0B 


File ’utiltest.R’ Page 


Printed Wed Apr IG 09:47:15 198G 


ANGDEG(ONE) = 
ANGRAD( ANGDE6(0NE ) )-0NE = 

ANGDEG(AMG1(-THREE*TW0PI-HAFPI ) ) = 
ANGDEG(ANG2( THREE*TWOPI-HAFPI ) ) - 

AN6DE6(ATANK-SIX,SIX ) ) = 
ANGDEG(ATAN2(-SIX,SIX ) ) = 

HMS( -3G:^85.874L0 ) = 
HM5( 3S385.874L0 ) = 

SECS( -100G.25874L0 ) = 
5ECS( 1006.25874L0 ) = 

JULIAN_DAYMUM( 1980, 4, 2 ) = 


57.29577951308232 

0.0L+00 

270 . 000000000000 
-90.000000000000 

315.000000000000 
-45.000000000000 

-1006.258740 
100G. 258740 

-3B385. 874000 
3G385. 874000 

2444332 


¥41124552 


1 5 4 



File ’utiltest.R’ Page 3 


Printed Wed Apr IG 09:47:15 198G 


TEST_UTILSPIF_MODULE 


"Sam Wilson 
-29 

"Ben Wheeler 
"N 

254.11112000 


START_RANDOM_NUMBER_SEQUENCE ( 1 ) 


Pseudorandom integers: 


1G807 

282475249 

1G22G50073 

984943G58 

1144108930 

470211272 

101027544 

1457850878 

1458777923 


2007237709 


START_RANDOM_NUMBER_SEQUENCE < 2147483G4G ) 

Pseudorandom integers: 

21474GG840 

1865008398 

524833574 

11G2539989 

1003374717 

1677272375 

204645G103 

6896327G9 

688705724 

140245938 



¥44759AD5 


1 55 : 



File ’utiltest.R’ Page 4 


Printed Wed Apr IG 00:47:15 1086 


W = 
W = 

DOTP(W,W) = 
WMA6(U) = 
SXU(TW0,'7) = 
CRSP(U,W) = 
WDIFOl.W) = 
USUM(U,W) = 

D = 
UXD(U,D) = 

M = 

WXM(U,M) = 
UXMT(U.M) = 


TEST_lJTILUEMQ_MODLILE 


2 . 0000000000000 

4 . 0000000000000 
-25.0000000000000 

7.0000000000000 

4.0000000000000 
-9.0000000000000 
- 2 . 0000000000000 

G. 0000000000000 

30.0000000000000 
G0. 0000000000000 

1 . 0000000000000 

4 . 0000000000000 

7.0000000000000 

- 1 . 0000000000000 

11 .0000000000000 


- 6 . 0000000000000 

5.0000000000000 

- 12.0000000000000 

14.0000000000000 
- 11. 0000000000000 

- 1 .0000000000000 

10.0000000000000 
-G0. 0000000000000 

3.0000000000000 

5 . 0000000000000 

8.0000000000000 

0.0000000000000 
- 4 . 0000000000000 


3.0000000000000 
- 1 .0000000000000 

G . 0000000000000 

34 . 0000000000000 

4 . 0000000000000 

2.0000000000000 

40.0000000000000 

120.0000000000000 

9.0000000000000 

6.0000000000000 

2 . 0000000000000 

- 12.0000000000000 

-28.0000000000000 


¥CFB219F2 


1 SB 



File ’utiitest.R’ Page 5 


Printed Wed Apr 16 09:47:15 1986 


L. = 


MDIF(L,M) = 


HSUH(L,M) = 


MXM(L,M ) = 


riXMT(L,M) = 


MTXM(L,M) = 




N = MXM(M,MINU(M ) ) = 


MDIF(N,IDN3X3) = 


1 .0000000000000 
- 2.0000000000000 

4.0000000000000 

0.0000000000000 
- 6.0000000000000 
-3 . 0000000000000 

2.0000000000000 

2 . 0000000000000 

11 .0000000000000 

- 12.0000000000000 

60.0000000000000 

- 12 .0000000000000 

- 20.0000000000000 

67 .0000000000000 

-23.0000000000000 

21 .0000000000000 

43 . 0000000000000 
-7 . 0000000000000 

-1.0270270270270 

0.9189189189189 

-0.0810810810811 

1 .0000000000000 
0.0000000000000 
2.7755575615BL-17 

-3.3L-1B 

I.IL-IG 

2.8L-17 


2.0000000000000 

5.0000000000000 

3.0000000000000 

- 1.0000000000000 
0 . 0000000000000 
-5.0000000000000 

5.0000000000000 

10 . 0000000000000 

11.0000000000000 

-11. 0000000000000 

67.0000000000000 
-5 . 0000000000000 

- 4 . 0000000000000 

53 . 0000000000000 

7.0000000000000 

25.0000000000000 

55.0000000000000 
- 11. 0000000000000 

1.7837837837838 

-1.6486486486436 

0.3513513513514 

0 . 0000000000000 

1 . 0000000000000 
- 0 . 0000000000000 

0. 0L+00 
4.4L-1G 
-7.8L-16 


-3.0000000000000 
G .0000000000000 
-4.0000000000000 

- 12.0000000000000 

0.0000000000000 

- 6.0000000000000 

6 . 0000000000000 

12.0000000000000 
- 2 . 0000000000000 

15 . 0000000000000 

24.0000000000000 

46.0000000000000 

17.0000000000000 

38 . 0000000000000 

44.0000000000000 

5.0000000000000 

54.0000000000000 

1 . 0000000000000 

-0.7297297297297 

0.8108108108108 

-0.1891891891892 

0 . 0000000000000 
0.0000000000000 

1.0000000000000 

0.0L+00 

0.0L+00 

4.4L-1G 


¥AD722332 
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X ■-= CRSP(W.U) 


9 . 0000000000000 - ] 4 . 0000000000000 


NC3] = SXU( 0NE/UMAG( X ), X ) 

Nil] = SXU( 0NE/7MA6( W ), U ) 

N[2] = CRSP( NC3], Nil] ) 

N = 0.6172133998484 0.7715167498105 

0.7500152304084 -0.5176735557710 

0.2377493915935 -0.3698323869232 

Q = IMATQ( N ) 


Q.S = 0.2243743946150 

Q.7 = 0.3707828839414 0.4368287457982 


P = QCXQ( Q, Q ) 

P.S = 1.0000000000000 

P.U = 0.0000000000000 0.0000000000000 



ONE - P.S 
P.0 


-2.2L-1G 

0.0L+00 0.0L+00 


N = MXMT( N, N ) = 1.0000000000000 5.55111512313L-17 

5.551 115123 13L-17 1.0000000000000 

-5.55111512313L-17 5.55111512313L-17 


MDIFCN, IDN3X3 ) 



0.0L+00 

5.GL-17 

5.GL-17 


5.6L-17 
0 . 0L+00 
5.GL-17 


-34.0000000000000 


-0.1543033499621 

0.4116931427785 

-0.8981643682420 


0.0239571893207 


0.0000000000000 


0.0L+00 

5.55111512313L-17 

5.55111512313L-17 

1.0000000000000 

-5.6L-17 
5.GL-17 
0 . 0L+00 


¥FA3B0D5B 


1 53 


File ’uliltest.R’ Page 7 


Printed Wed Apr 16 09:47:15 1986 


PRY “ 

RPR = 

P = 
Q = 

P.S = 

P. U = 

Q. S = 

Q.U = 

EULDEG( QPRY( P ) ) = 

EULDEG( QRPR( Q ) ) = 


-145.0000000000000 

10.0000000000000 

PRYQ( EULRAD( PRY ) 
RPRQ( EULRAD( RPR ) 

0.5325855897693 

0.8153775734730 

0.9576621989425 

0.2566048122926 

-145.0000000000000 

-170.0000000000000 


65.0000000000000 

-15 . 0000000000000 

) 

) 

0.0908499818748 

-0.1300295006517 

65 . 0000000000000 

15 . 0000000000000 


-170.0000000000000 

20 , 0000000000000 

-0.2079862568553 

0.0113761072310 
-170.0000000000000 
-160 . 0000000000000 



EULDEG( QPYR( P 
EULDE6( QYRY( Q 



PYR 


80 . 0000000000000 

-35.0000000000000 

YRY 


-5.0000000000000 

80.0000000000000 

P 

= 

PYRQ( EULRAD( PYR ) 

) 

Q 


YRYQ( EULRAD< YRY ) 

) 

P.S 

= 

0.532B888026743 


P.U 


0.53G0G4146G904 

0.1070262978581 

Q.S 

= 

0.6634139481688 


Q.U 


0.5825S34160G96 

0.2716537822742 

) ) 

= 

80 .0000000000000 

-35 . 0000000000000 

) ) 


-5 . 0000000000000 

80 . 0000000000000 


120.0000000000000 

-55.0000000000000 


-0.6460829990840 

-0.3830222215595 

120.0000000000000 

-55.0000000000000 
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R = 


R.S = 


R.U = 


R = 

R.S = 
R.U = 

R = 

R.S = 
R.U = 

QMAT( R ) = 



N = 
N = 


ROT(>J,Q) = 
IROT(U,Q) = 
X = 
X = 


QCXQ( P, Q ) 

0.9422227864928 
-0. 1798248B34331 

QXQC< P, Q > 

0.9422227864928 

-0.0892100165536 

QXQ( P, Q ) 

-0.23543B4230378 

0.8004748806090 

0.3923806875575 

0.3301692551544 

-0.8585019854273 


0.2447640278487 


0.0973556494454 


0.0446498281944 

-0.1872049915819 

-0.8851521670988 

-0.4259811406708 


HDIF( QMAT(R), NXM( QMAT( P ) , QMAT( Q ) ) ) 

-5.BL-17 


5.BL-17 
0.0L+00 
-1 . IL-IG 

-0.1519683046476 


-5.BL-17 

3.1770527943276 


-4.0877962276343 -3.4935338305642 

UDIF( U, IROT(ROT(U,Q),Q) ) 

4.4L-16 0.0L+00 


¥B1B7F757 
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0.1413145773664 


-0.3078630719675 


-0.5493778745667 

-0.9005507687847 

0.3278626298179 

-0.2855072832874 


-1 . lL-16 
5.GL-17 
-2.8L-16 

6.2356428037884 

-4.481B451B40041 

0 . 0L+00 



File ’ ut i 1 test . R ’ 


Page 9 


Printed 


Wed Apr IB 09:47: IS 1986 


P.S = PI * R.S 
P.U = SXU( PI, R.U ) 

P.S = -0.739G453370029 

P. U = 2.5147GG0043043 0.1402715722396 -1.7259214947836 

Q = UNIQUAK P ) 

Q. S = -0.2354364230378 

Q.U = 0.8004748806090 0.0446498281944 -0.5493778745667 

R = QXQC( Q, Q ) 


ONE - R.S = 
R.U = 


2.2L-16 

0.0L+00 0.0L+00 


0.0L+00 


RPRPB 


10.0000000000000 -15.0000000000000 


20 . 0000000000000 


NERTENS P 


25.0000000000000 
0.0000000000000 
0 . 0000000000000 


0 . 0000000000000 

40.0000000000000 
0.0000000000000 


0 . 0000000000000 
0.0000000000000 

55 . 0000000000000 


MPB 

NERTENS B 


QMAT(RPRQ( EULRAD( RPRPB ))) 
MTXM( MPB,MXM( NERTENS_P, MPB)) 


NERTENS B 


26.9793202303121 

3.1503479728235 

6.7143670804884 


3.1503479728235 

43.4622804063605 

5.7920928450464 


6.7143670804884 

5.7920928450464 

49.5583993633275 


S = NERTENS_B[1,13, 

NERTENS_B[ 2 ,11, NERTENS..BI 2,21, 

NERTENS_BI3,1], NERTENS_B[ 5 , 2 ] , NERTENS„B[ 3 , 3 1 


DIAGONALIZE ( 5, 1.0L-8, E, N ) 


E = 25.0000000000000 40.0000000000000 55.0000000000000 

RPRBP = EULDEG( QRPR( IMATQ< N ) ) ) 

RPRBP = -20.0000000000000 15.0000000000000 -9.9999999957838 
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TEST_UTILSTAT MODULE 


Test UN I FORM_RANDOM SCALAR Function 


CUMULATIUE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

UNIFORMLY DISTRIBUTED POPULATION 
HADING ZERO MEAN 
( UNCERTAINTY = 5.0 > 

CPU Time = 0.80 sec 


CLASS 

UPPER BOUND 


ACTUAL EXPECTED ACTUAL / 

DISTRIBUTION DISTRIBUTION EXPECTED 


~5, 

.0 

0 

0 

1 

. 0000 


.0 

103 

100 

1 

.0300 

-3, 

.0 

215 

200 

1 

.0750 

-2, 

.0 

328 

300 

1 

.0933 


.0 

412 

400 

1 , 

.0300 

0. 

.0 

513 

500 

1 

.0260 

1 . 

.0 

602 

600 

1 , 

. 0033 

2, 

.0 

704 

700 

1, 

.0057 

3. 

.0 

809 

800 

1 - 

.0113 

4, 

.0 

912 

900 

1 . 

.0133 

5. 

.0 

1000 

1000 

1 . 

.0000 


¥648E154E 
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Test GAUSSIAI4_RAND0M SCALAR Function 


CUMULATIVE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

NORMALLY DISTRIBUTED POPULATION 
HAVING ZERO MEAN 
< SIGMA = 10.0 ) 

CPU Tine = 2.83 sec 


CLASS 

ACTUAL 

EXPECTED 

ACTUAL / 

ER BOUND 

DISTRIBUTION 

DISTRIBUTION 

EXPECTED 

-25.0 

B 

6 

1.0000 

-20.0 

21 

23 

0.9130 

-15.0 

63 

67 

0.9403 

-10.0 

146 

159 

0.9182 

-5.0 

298 

309 

0.9644 

0.0 

485 

500 

0.9700 

5.0 

687 

691 

0.9942 

10.0 

841 

841 

1 .0000 

15.0 

937 

933 

1.0043 

20.0 

981 

977 

1.0041 

25.0 

994 

994 

1 . 0000 


¥BE3AD97A 
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Test SIXTUC_MATRIX Function 


SIXPOPIN 


5IXP0P0UT 


SIXPOPOUT 


ISIXPOPOUT-SIXPOPINI 


= 1.000 





0.487 

1.000 




0 . 535 

0.699 

1.000 



-0.478 

-0.996 

-0.706 

1.000 


-0.199 

-0.662 

-0.627 

0.667 

1.000 

-0.460 

-0.778 

-0.871 

0.789 

0.720 


= T * 


u)her< 

2 M 

is SIXTUC^ 

.MATRIX! SIXPOPIN ) 



and 

F is 

the trans 

i p O 5 e 

of M . 


= 1 

. 000 







0 

.487 

1 

.000 





0 

.53E 

0, 

.699 

1.000 




-0 

.478 

-0 

.998 

-0.706 

1 

. 000 



.199 


. 66 ? 

-0.627 

0 

.667 1 

.000 

-0 

.480 

-0, 

.778 

-0.871 

0 

.789 0 

.720 


= 2.2L-16 

0 . 0L+00 
0.0L+00 
0.0L+00 

0.0L+00 
0 . 0L+00 
0.0L+00 

1 . lL-16 
0.0L+00 

0.0L+00 


0 . 0L+00 

0 . 0L+00 

0 . 0L+00 

0 . 0L+00 

0 . 0L+00 

0.0L+00 

0 , 0L+00 

0.0L+00 

0 . 0L+00 

l.lL-16 


¥S2A226E2 
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1.000 


1.000 


0.0L+00 
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Test GAUSSIAN_RANDOM_SIXiJECTOR Function 


ASTP / Apollo STDN 2-Station Estimation Error 


SIXPOPIN = 75.301 

0.487 179.906 

0.535 0.699 79.855 

-0.478 -0.996 -0.706 

0.190 


-0.199 -0.662 -0.627 

0.667 

0.114 

-0.460 -0.778 -0.871 

0.789 

0.720 

SIXPOPOUT = statistical summary of 1000 

pseudorandom 

six-vectors from population 

defined by 

SIXPOPIN 

CPU time = 18,42 sec 




SIXPOPOUT = 7G.G2G 





0.504 

183.598 




0.5G7 

0.711 

79.939 



-0.498 

-0.99G 

-0.720 

0.193 


-0.222 

-0.B71 

-0.640 

0.G77 

0.113 

-0.473 

-0.787 

-0.875 

0.798 

0.729 


.417 


.415 


SFR1 F7APF 
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Test GAUSSIAN_RAND0M_5IXUECT0R Function 


RAIDS / Long-Range Stationkeep without TIC ; 0,5 deg Deadbands 


SIXPOPIN = 

10. 

100 








0. 

376 

40.300 







-0, 

192 

0.1GB 

11. 

.900 





-0. 

405 

-0.GB2 

-0. 

.088 

0.0G3 




0. 

553 

-0.052 

-0. 

.558 

0.0B8 

0, 

.073 


-0. 

341 

0.274 

0. 

.187 

-0.208 

-0, 

. 36 1 

SIXPOPOUT = 

st at i 

st ical 

supimary 

of 

1000 

pseudorandom 



six- V 

ec t ors 

fron populd 

^it ion 

defined 

by SIXPOPIN 

CPU time = 

18.40 

sec 








SIXPOPOUT = 10.1G2 





0.345 

38.759 




-0.201 

0.126 

11.897 



-0.398 

-0.607 

-0,025 

0.0B1 


0.576 

-0.019 

-0.345 

0.052 

0.072 

-0.414 

0.237 

0.198 

-0.141 

-0.389 




I fz; p: 
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Test 6AUSSIAN_RAND0M_SIXUECT0R Function 

I 


RAIDS / Long-Range Stationkeep with TIC ; 3.0 deg Deadbands 


SIXPOPIN = 6.900 

0.431 27.800 

0.301 0.098 

-0.467 -0.360 

0.519 0.515 

-0.072 0.056 


6.900 




0.332 

0.042 



0.329 

0.104 

0.063 


0.363 

0.068 

-0.015 

0.024 


SIXPOPOUT = statistical sunnary of 1000 pseudorandom 

six-vectors from population defined by SIXPOPIN 


CPU time 


18.38 sec 


SIXPOPOUT 


G, 

.884 





0, 

.422 

27, 

.852 



0, 

.331 

0, 

.101 

6 , 

.925 

-0. 

.489 

-0. 

.311 

0. 

.28B 

0. 

.523 

0, 

.544 

0. 

. 33B 

-0, 

.042 

0. 

,0B7 

0. 

,411 


0.042 

0.107 0.063 

0.102 0.002 0.024 


I 
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Tests 


completed 


Elapsed tine = 150.58 seconds 
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